diff -Nrcpad gcc-4.3.3/gcc/fortran/ChangeLog gcc-4.4.0/gcc/fortran/ChangeLog *** gcc-4.3.3/gcc/fortran/ChangeLog Sat Jan 24 10:15:54 2009 --- gcc-4.4.0/gcc/fortran/ChangeLog Tue Apr 21 08:44:29 2009 *************** *** 1,1072 **** ! 2009-01-24 Release Manager ! ! * GCC 4.3.3 released. ! ! 2009-01-17 Paul Thomas ! ! PR fortran/38657 ! * module.c (write_common_0): Revert patch of 2009-01-10. ! ! 2009-01-14 Mikael Morin ! ! PR fortran/35681 ! * ChangeLog: Fix function name. ! ! PR fortran/38487 ! * dependency.c (gfc_check_argument_var_dependency): ! Move the check for pointerness inside the if block ! so that it doesn't affect the return value. ! ! PR fortran/38669 ! * trans-stmt.c (gfc_trans_call): ! Add the dependency code after the loop bounds calculation one. ! ! 2009-01-11 Paul Thomas ! ! PR fortran/38763 ! Backport from mainline: ! * target-memory.c (encode_derived): Encode NULL. ! ! PR fortran/38765 ! Backport from mainline: ! * resolve.c (check_host_association): Use the symtree name to ! search for a potential contained procedure, since this is the ! name by which it would be referenced. ! ! 2009-01-10 Paul Thomas ! ! PR fortran/38657 ! * module.c (write_common_0): Use the name of the symtree rather ! than the common block, to determine if the common has been ! written. ! ! 2009-01-10 Paul Thomas ! ! PR fortran/38665 ! * gfortran.h : Add bit to gfc_expr 'user_operator' ! * interface.c (gfc_extend_expr): Set the above if the operator ! is substituted by a function. ! * resolve.c (check_host_association): Return if above is set. ! ! 2009-01-01 John David Anglin ! ! PR fortran/38675 ! Backport from mainline: ! 2008-12-09 Mikael Morin ! ! PR fortran/37469 ! * expr.c (find_array_element): Simplify array bounds. ! Assert that both bounds are constant expressions. ! ! 2008-10-31 Mikael Morin ! ! * expr.c (gfc_reduce_init_expr): New function, containing checking code ! from gfc_match_init_expr, so that checking can be deferred. ! (gfc_match_init_expr): Use gfc_reduce_init_expr. ! * match.h (gfc_reduce_init_expr): Prototype added. ! ! 2008-12-22 Paul Thomas ! ! PR fortran/38602 ! * trans-decl.c (init_intent_out_dt): Allow for optional args. ! ! 2008-12-21 Mikael Morin ! ! PR fortran/38487 ! * dependency.c (gfc_is_data_pointer): New function. ! (gfc_check_argument_var_dependency): Disable the warning ! in the pointer case. ! (gfc_check_dependency): Use gfc_is_data_pointer. ! ! 2008-12-21 Mikael Morin ! ! PR fortran/38113 ! * error.c (show_locus): Start counting columns at 0. ! * primary.c (match_actual_arg): Eat spaces ! before copying the current locus. ! (match_variable): Copy the locus before matching. ! ! 2008-12-21 Mikael Morin ! ! PR fortran/35983 ! * trans-expr.c (gfc_trans_subcomponent_assign): ! Add se's pre and post blocks to current block. ! (gfc_trans_structure_assign): Remove specific handling ! of C_NULL_PTR and C_NULL_FUNPTR. ! ! 2008-12-14 Paul Thomas ! ! PR fortran/35937 ! * trans-expr.c (gfc_finish_interface_mapping): Fold convert the ! character length to gfc_charlen_type_node. ! ! 2008-12-04 Janis Johnson ! ! Backport from mainline: ! 2008-10-18 Jakub Jelinek ! Janis Johnson ! ! * Make-lang.in (check-f95-subtargets, check-fortran-subtargets): New ! aliases for check-gfortran-subtargets. ! (lang_checks_parallelized): Add check-gfortran. ! (check_gfortran_parallelize): New variable. ! ! 2008-11-24 Paul Thomas ! ! PR fortran/34820 ! * trans-expr.c (gfc_conv_function_call): Remove all code to ! deallocate intent out derived types with allocatable ! components. ! (gfc_trans_assignment_1): An assignment from a scalar to an ! array of derived types with allocatable components, requires ! a deep copy to each array element and deallocation of the ! converted rhs expression afterwards. ! * trans-array.c : Minor whitespace. ! * trans-decl.c (init_intent_out_dt): Add code to deallocate ! allocatable components of derived types with intent out. ! (generate_local_decl): If these types are unused, set them ! referenced anyway but allow the uninitialized warning. ! ! PR fortran/34143 ! * trans-expr.c (gfc_trans_subcomponent_assign): If a conversion ! expression has a null data pointer argument, nullify the ! allocatable component. ! ! PR fortran/32795 ! * trans-expr.c (gfc_trans_subcomponent_assign): Only nullify ! the data pointer if the source is not a variable. ! ! 2008-11-29 Paul Thomas ! ! PR fortran/37735 ! * trans-array.c (structure_alloc_comps): Do not duplicate the ! descriptor if this is a descriptorless array! ! ! 2008-11-27 Paul Thomas ! ! PR fortran/36526 ! * interface.c (check_intents): Correct error where the actual ! arg was checked for a pointer argument, rather than the formal. ! ! 2008-11-24 Paul Thomas ! ! PR fortran/38033 ! * trans-array.c (gfc_trans_create_temp_array): Stabilize the ! 'to' expression. ! (gfc_conv_loop_setup): Use the end expression for the loop 'to' ! if it is available. ! ! 2008-11-24 Paul Thomas ! ! PR fortran/37926 ! * trans-expr.c (gfc_free_interface_mapping): Null sym->formal ! (gfc_add_interface_mapping): Copy the pointer to the formal ! arglist and set attr.always_explicit if this is a procedure. ! ! 2008-11-24 Steven G. Kargl ! ! PR fortran/37792 ! * fortran/resolve.c (resolve_fl_variable): Simplify the ! initializer if there is one. ! ! 2008-11-24 Mikael Morin ! ! PR fortran/35681 ! * dependency.c (gfc_check_argument_var_dependency): Add ! elemental check flag. Issue a warning if we find a dependency ! but don't generate a temporary. Add the case of an elemental ! function call as actual argument to an elemental procedure. ! Add the case of an operator expression as actual argument ! to an elemental procedure. ! (gfc_check_argument_dependency): Add elemental check flag. ! Update calls to gfc_check_argument_var_dependency. ! (gfc_check_fncall_dependency): Add elemental check flag. ! Update call to gfc_check_argument_dependency. ! * trans-stmt.c (gfc_trans_call): Make call to ! gfc_conv_elemental_dependencies unconditional, but with a flag ! whether we should check dependencies between variables. ! (gfc_conv_elemental_dependencies): Add elemental check flag. ! Update call to gfc_check_fncall_dependency. ! * trans-expr.c (gfc_trans_arrayfunc_assign): Update call to ! gfc_check_fncall_dependency. ! * resolve.c (find_noncopying_intrinsics): Update call to ! gfc_check_fncall_dependency. ! * dependency.h (enum gfc_dep_check): New enum. ! (gfc_check_fncall_dependency): Update prototype. ! ! 2008-11-19 Paul Thomas ! ! PR fortran/38171 ! * module.c (load_equiv): Regression fix; check that equivalence ! members come from the same module only. ! ! 2008-11-14 Paul Thomas ! ! PR fortran/37836 ! * intrinsic.c (add_functions): Reference gfc_simplify._minval ! and gfc_simplify_maxval. ! * intrinsic.h : Add prototypes for gfc_simplify._minval and ! gfc_simplify_maxval. ! * simplify.c (min_max_choose): New function extracted from ! simplify_min_max. ! (simplify_min_max): Call it. ! (simplify_minval_maxval, gfc_simplify_minval, ! gfc_simplify_maxval): New functions. ! ! 2008-11-08 Paul Thomas ! ! PR fortran/37597 ! * parse.c (gfc_fixup_sibling_symbols ): Fixup contained, even ! when symbol not found. ! ! 2008-11-08 Mikael Morin ! ! PR fortran/35820 ! * resolve.c (gfc_count_forall_iterators): New function. ! (gfc_resolve_forall): Use gfc_count_forall_iterators to evaluate ! the needed memory amount to allocate. Don't forget to free allocated ! memory. Add an assertion to check for memory leaks. ! ! 2008-11-08 Paul Thomas ! ! PR fortran/37445 ! * resolve.c (resolve_call): Check host association is correct. ! (resolve_actual_arglist ): Remove return is old_sym is use ! associated. Only reparse expression if old and new symbols ! have different types. ! ! PR fortran/PR35769 ! * resolve.c (gfc_resolve_assign_in_forall): Change error to a ! warning. ! ! 2008-11-01 Mikael Morin ! ! PR fortran/37903 ! * trans-array.c (gfc_trans_create_temp_array): If n is less ! than the temporary dimension, assert that loop->from is ! zero (reverts to earlier versions). If there is at least one ! null loop->to[n], it is a callee allocated array so set the ! size to NULL and break. ! (gfc_trans_constant_array_constructor): Set the offset to zero. ! (gfc_trans_array_constructor): Remove loop shifting around the ! temporary creation. ! (gfc_conv_loop_setup): Prefer zero-based descriptors if ! possible. Calculate the translation from loop variables to ! array indices if an array constructor. ! ! 2008-11-01 Mikael Morin ! ! PR fortran/37749 ! * trans-array.c (gfc_trans_create_temp_array): If size is NULL ! use the array bounds for loop->to. ! ! 2008-10-19 Paul Thomas ! ! PR fortran/37723 ! * dependency.c (gfc_dep_resolver ): If we find equal array ! element references, go on to the next reference. ! ! 2008-10-19 Paul Thomas ! ! PR fortran/37787 ! * dependency.c (gfc_are_equivalenced_arrays): Look in symbol ! namespace rather than current namespace, if it is available. ! ! 2008-10-11 Paul Thomas ! ! PR fortran/37794 ! * module.c (check_for_ambiguous): Remove redundant code. ! ! 2008-10-11 Paul Thomas ! ! PR fortran/35680 ! * gfortran.h : Add 'error' bit field to gfc_expr structure. ! * expr.c (check_inquiry): When checking a restricted expression ! check that arguments are either variables or restricted. ! (check_restricted): Do not emit error if the expression has ! 'error' set. Clean up detection of host-associated variable. ! ! 2008-10-05 Paul Thomas ! ! PR fortran/37706 ! * module.c (load_equiv): Check the module before negating the ! unused flag. ! ! 2008-09-26 Tobias Burnus ! ! PR fortran/37580 ! * expr.c (gfc_check_pointer_assign): Add checks for pointer ! remapping. ! ! 2008-09-26 Tobias Burnus ! ! PR fortran/37504 ! * expr.c (gfc_check_pointer_assign): Allow assignment of ! protected pointers. ! ! 2008-09-25 Tobias Burnus ! ! PR fortran/37626 ! * trans-array.c (gfc_trans_deferred_array): Don't auto-deallocate ! result variable. ! ! 2008-09-24 Paul Thomas ! ! PR fortran/35945 ! * resolve.c (resolve_fl_variable_derived): Remove derived type ! comparison for use associated derived types. Host association ! of a derived type will not arise if there is a local derived type ! whose use name is the same. ! ! PR fortran/36700 ! * match.c (gfc_match_call): Use the existing symbol even if ! it is a function. ! ! 2008-09-24 Paul Thomas ! ! PR fortran/37583 ! * decl.c (gfc_match_entry): Both subroutines and functions can ! give a true for get_proc_mame's last argument so remove the ! && gfc_current_ns->proc_name->attr.function. ! resolve.c (resolve_actual_arglist): Add check for recursion by ! reference to procedure as actual argument. ! ! 2008-09-23 Paul Thomas ! ! PR fortran/37274 ! PR fortran/36374 ! * module.c (check_for_ambiguous): New function to test loaded ! symbol for ambiguity with fixup symbol. ! (read_module): Call check_for_ambiguous. ! (write_symtree): Do not write the symtree for symbols coming ! from an interface body. ! ! PR fortran/36374 ! * resolve.c (count_specific_procs ): New function to count the ! number of specific procedures with the same name as the generic ! and emit appropriate errors for and actual argument reference. ! (resolve_assumed_size_actual): Add new argument no_formal_args. ! Correct logic around passing generic procedures as arguments. ! Call count_specific_procs from two locations. ! (resolve_function): Evaluate and pass no_formal_args. ! (resolve call): The same and clean up a bit by using csym more ! widely. ! ! PR fortran/36454 ! * symbol.c (gfc_add_access): Access can be updated if use ! associated and not private. ! ! 2008-09-13 Daniel Kraft ! ! PR fortran/35770 ! * primary.c (gfc_match_varspec): Added missing type-spec clearing ! after wrong implicit character typing. ! ! 2008-09-11 Daniel Kraft ! ! PR fortran/36214 ! * simplify.c (simplify_cmplx): Added linebreak to long line. ! * target-memory.c (gfc_convert_boz): Fix indentation. ! (gfc_interpret_float): Set mpfr precision to right value before ! calling mpfr_init. ! ! 2008-09-08 Daniel Kraft ! ! PR fortran/37199 ! * trans-expr.c (gfc_add_interface_mapping): Set new_sym->as. ! (gfc_map_intrinsic_function): Added checks against NULL bounds in ! array specs. ! ! 2008-09-05 Daniel Kraft ! ! PR fortran/35837 ! * resolve.c (resolve_types): Restore gfc_current_ns on exit. ! * symbol.c (gfc_save_all): Removed blank line. ! ! 2008-09-04 Daniel Kraft ! ! * PR fortran/37099 ! * expr.c (simplify_const_ref): Update expression's character length ! when pulling out a substring reference. ! ! 2008-08-30 Daniel Kraft ! ! PR fortran/37193 ! * module.c (read_module): Initialize use_only flag on used symbols. ! ! 2008-06-24 Paul Thomas ! ! PR fortran/36371 ! * expr.c (gfc_check_assign): Change message and locus for ! error when conform == 0. ! ! 2008-08-27 Release Manager ! ! * GCC 4.3.2 released. ! ! 2008-07-27 Tobias Burnus ! ! PR fortran/36132 ! ! * trans-array.c (gfc_conv_array_parameter): Fix packing/unpacking ! for nonpresent optional actuals to optional formals. ! * trans-array.h (gfc_conv_array_parameter): Update declaration. ! * trans-expr.c (gfc_conv_function_call,gfc_trans_arrayfunc_assign): ! Update gfc_conv_array_parameter calls. ! * trans-intrinsics (gfc_conv_intrinsic_transfer, ! gfc_conv_intrinsic_loc): Ditto. ! ! 2008-07-19 Paul Thomas ! ! PR fortran/36366 ! * resolve.c (add_dt_to_dt_list): New function. ! (resolve_fl_derived): Call new function for pointer components ! and when derived type resolved. ! ! 2008-07-17 Tobias Burnus ! ! PR fortran/36824 ! * resolve.c (resolve_fl_derived): Fix constantness check ! for the array dimensions. ! ! 2008-06-20 Laurynas Biveinis ! Tobias Burnus ! ! PR fortran/34908 ! PR fortran/36276 ! * scanner.c (preprocessor_line): do not call gfc_free for ! current_file->filename if it differs from filename. ! ! 2008-06-06 Release Manager ! ! * GCC 4.3.1 released. ! ! 2008-05-18 Francois-Xavier Coudert ! PR fortran/36176 ! * target-memory.c (gfc_target_expr_size): Correctly treat ! substrings. ! (gfc_target_encode_expr): Likewise. ! (gfc_interpret_complex): Whitespace change. ! 2008-05-17 Jerry DeLisle ! Backport from mainline: ! PR fortran/35184 ! * trans-array.c (gfc_conv_array_index_offset): Remove ! unnecessary assert. ! 2008-05-17 Paul Thomas Backport from mainline: ! PR fortran/35756 ! PR fortran/35759 ! * trans-stmt.c (gfc_trans_where): Tighten up the dependency ! check for calling gfc_trans_where_3. ! ! PR fortran/35743 ! * trans-stmt.c (gfc_trans_where_2): Set the mask size to zero ! if it is calculated to be negative. ! ! PR fortran/35745 ! * trans-stmt.c (gfc_trans_where_3, gfc_trans_where_assign): Set ! ss->where for scalar right hand sides. ! * trans-array.c (gfc_add_loop_ss_code): If ss->where is set do ! not evaluate scalars outside the loop. Clean up whitespace. ! * trans.h : Add a bitfield 'where' to gfc_ss. ! ! PR fortran/36233 ! * interface.c (compare_actual_formal): Do not check sizes if the ! actual is BT_PROCEDURE. ! ! 2008-05-13 Paul Thomas ! ! PR fortran/35997 ! * module.c (find_symbol): Do not return a result for a symbol ! that has been renamed in another module. ! ! 2008-05-01 Paul Thomas ! ! PR fortran/35864 ! * expr.c (scalarize_intrinsic_call): Reorder identification of ! array argument so that if one is not found a segfault does not ! occur. Return FAILURE if all scalar arguments. ! ! PR fortran/35780 ! * expr.c (scalarize_intrinsic_call): Identify which argument is ! an array and use that as the template. ! (check_init_expr): Remove tests that first argument is an array ! in the call to scalarize_intrinsic_call. ! ! 2008-04-26 Jerry DeLisle ! Francois-Xavier Coudert ! PR fortran/35994 ! * trans-instrinsic.c (gfc_conv_intrinsic_minmaxloc): ! Correctly adjust loop counter offset. ! 2008-04-19 Paul Thomas ! PR fortran/35944 ! PR fortran/35946 ! PR fortran/35947 ! * trans_array.c (gfc_trans_array_constructor): Temporarily ! realign loop, if loop->from is not zero, before creating ! the temporary array and provide an offset. ! PR fortran/35959 ! * trans-decl.c (gfc_init_default_dt): Add gfc_ prefix to name ! and allow for NULL body. Change all references from ! init_default_dt to gfc_init_default_dt. ! * trans.h : Add prototype for gfc_init_default_dt. ! * trans-array.c (gfc_trans_deferred_vars): After nullification ! call gfc_init_default_dt for derived types with allocatable ! components. ! 2008-04-18 Jerry DeLisle ! PR fortran/35724 ! * iresolve.c (gfc_resolve_eoshift): Check for NULL symtree in ! test for optional argument attribute. ! 2008-04-16 Paul Thomas ! PR fortran/35932 ! * trans-intrinsic.c (gfc_conv_intrinsic_char): Even though KIND ! is not used, the argument must be converted. ! 2008-04-16 Jakub Jelinek ! PR target/35662 ! * f95-lang.c (gfc_init_builtin_functions): Make sure ! BUILT_IN_SINCOS{,F,L} types aren't varargs. ! 2008-04-03 Jakub Jelinek ! PR fortran/35786 ! * openmp.c (resolve_omp_clauses): Diagnose if a clause symbol ! isn't a variable. ! 2008-04-01 Joseph Myers ! * gfortran.texi: Include gpl_v3.texi instead of gpl.texi ! * Make-lang.in (GFORTRAN_TEXI): Include gpl_v3.texi instead of ! gpl.texi. ! 2008-03-30 Paul Thomas ! PR fortran/35740 ! * resolve.c (resolve_function, resolve_call): If the procedure ! is elemental do not look for noncopying intrinsics. ! 2008-03-29 Paul Thomas ! PR fortran/35698 ! * trans-array.c (gfc_array_init_size): Set 'size' zero if ! negative in one dimension. ! PR fortran/35702 ! * trans-expr.c (gfc_trans_string_copy): Only assign a char ! directly if the lhs and rhs types are the same. ! 2008-03-27 Jerry DeLisle ! PR fortran/35724 ! * iresolve.c (gfc_resolve_cshift): Check for NULL symtree in ! test for optional argument attribute. ! 2008-03-24 Paul Thomas ! PR fortran/34813 ! * resolve.c (resolve_structure_cons): It is an error to assign ! NULL to anything other than a pointer or allocatable component. ! PR fortran/33295 ! * resolve.c (resolve_symbol): If the symbol is a derived type, ! resolve the derived type. If the symbol is a derived type ! function, ensure that the derived type is visible in the same ! namespace as the function. ! 2008-03-14 Paul Thomas ! PR fortran/35474 ! * module.c (mio_symtree_ref): After providing a symbol for a ! missing equivalence member, resolve and NULL the fixups. ! 2008-03-05 Release Manager ! * GCC 4.3.0 released. ! 2008-03-02 Jakub Jelinek * gfortranspec.c (lang_specific_driver): Update copyright notice dates. ! 2008-02-28 Uros Bizjak ! ! Backport from mainline: ! 2008-02-25 Francois-Xavier Coudert ! ! PR target/25477 ! * trans-expr.c (gfc_conv_power_op): Use BUILT_IN_CPOW{F,,L}. ! * f95-lang.c (gfc_init_builtin_functions): Define BUILT_IN_CPOW{F,,L}. ! * trans.h (gfor_fndecl_math_cpow, gfor_fndecl_math_cpowf, ! gfor_fndecl_math_cpowl10, gfor_fndecl_math_cpowl16): Remove. ! * trans-decl.c: Likewise. ! ! 2008-02-16 Francois-Xavier Coudert ! ! PR fortran/34952 ! * gfortran.texi: Create new section for unimplemented extensions. ! Add "STRUCTURE and RECORD" and "ENCODE and DECODE statements". ! Remove "smaller projects" list. Fix a few typos. ! ! 2008-02-15 Francois-Xavier Coudert ! ! * intrinsic.texi: Rename INDEX node to avoid clashing with ! index.html on case-insensitive systems. ! ! 2008-02-15 Francois-Xavier Coudert ! ! PR fortran/35150 ! * trans-expr.c (gfc_conv_function_call): Force evaluation of ! se->expr. ! ! 2008-02-10 Daniel Franke ! ! fortran/PR35019 ! * lang.opt: Allow '-J' next to '-J ', ! likewise '-I ' and '-I'. ! ! 2008-02-06 Kaveh R. Ghazi ! ! PR other/35107 ! * Make-lang.in (f951): Add $(GMPLIBS). ! ! 2008-02-05 Francois-Xavier Coudert ! ! PR fortran/35037 ! * trans-common.c (build_field): Mark fields as volatile when needed. ! ! 2008-02-05 Tobias Burnus ! ! PR fortran/35093 ! * data.c (gfc_assign_data_value): Only free "size" if ! it has not already been freed. ! ! 2008-02-05 Paul Thomas ! ! PR fortran/34945 ! * array.c (match_array_element_spec): Remove check for negative ! array size. ! (gfc_resolve_array_spec): Add check for negative size. ! ! 2008-02-05 Paul Thomas ! ! PR fortran/32315 ! * data.c (gfc_assign_data_value): Add bounds check for array ! references. ! ! 2008-02-04 Daniel Franke ! ! * resolve.c (resolve_where): Fix typo. ! (gfc_resolve_where_code_in_forall): Likewise. ! ! 2008-02-03 Paul Thomas ! ! PR fortran/32760 ! * resolve.c (resolve_allocate_deallocate): New function. ! (resolve_code): Call it for allocate and deallocate. ! * match.c (gfc_match_allocate, gfc_match_deallocate) : Remove ! the checking of the STAT tag and put in above new function. ! * primary,c (match_variable): Do not fix flavor of host ! associated symbols yet if the type is not known. ! ! 2008-01-31 Paul Thomas ! ! PR fortran/34910 ! * expr.c (gfc_check_assign): It is an error to assign ! to a sibling procedure. ! ! 2008-01-30 Paul Thomas ! ! PR fortran/34975 ! * symbol.c (gfc_delete_symtree, gfc_undo_symbols): Rename ! delete_symtree to gfc_delete_symtree. ! * gfortran.h : Add prototype for gfc_delete_symtree. ! * module.c (load_generic_interfaces): Transfer symbol to a ! unique symtree and delete old symtree, instead of renaming. ! (read_module): The rsym and the found symbol are the same, so ! the found symtree can be deleted. ! ! PR fortran/34429 ! * decl.c (match_char_spec): Remove the constraint on deferred ! matching of functions and free the length expression. ! delete_symtree to gfc_delete_symtree. ! (gfc_match_type_spec): Whitespace. ! (gfc_match_function_decl): Defer characteristic association for ! all types except BT_UNKNOWN. ! * parse.c (decode_specification_statement): Only derived type ! function matching is delayed to the end of specification. ! ! 2008-01-28 Tobias Burnus ! ! PR libfortran/34980 ! * simplify.c (gfc_simplify_shape): Simplify rank zero arrays. ! ! 2008-01-27 Jerry DeLisle ! ! PR fortran/34990 ! * array.c (gfc_check_constructor_type): Revert clearing the expression. ! ! 2008-01-26 Tobias Burnus ! ! PR fortran/34848 ! * trans-expr.c (gfc_conv_function_call): Don't call ! gfc_add_interface_mapping if the expression is NULL. ! ! 2008-01-26 Jerry DeLisle ! ! PR fortran/31610 ! * trans-array.c (gfc_trans_create_temp_array): Remove call to ! gcc_assert (integer_zerop (loop->from[n])). ! ! 2008-01-25 Daniel Franke ! ! PR fortran/34661 ! * resolve.c (resolve_where): Added check if user-defined assignment ! operator is an elemental subroutine. ! (gfc_resolve_where_code_in_forall): Likewise. ! ! 2008-01-24 Daniel Franke ! ! PR fortran/33375 ! PR fortran/34858 ! * gfortran.h: Revert changes from 2008-01-17. ! * match.c: Likewise. ! * symbol.c: Likewise. ! (gfc_undo_symbols): Undo namespace changes related to common blocks. ! ! 2008-01-24 Daniel Franke ! ! PR fortran/34202 ! * data.c (formalize_structure_cons): Skip formalization on ! empty structures. ! ! 2008-01-24 Daniel Franke ! ! * gfortran.texi (OpenMP): Extended existing documentation. ! (contributors): Added major contributors of 2008 that were ! not listed yet. ! (proposed extensions): Removed implemented items. ! ! 2008-01-24 Paul Thomas ! ! PR fortran/34872 ! * parse.c (next_statement) : If ST_GET_FCN_CHARACTERISTICS is ! seen, check for a statement label and, if present, delete it ! and set the locus to the start of the statement. ! ! 2008-01-22 Paul Thomas ! ! PR fortran/34875 ! * trans-io.c (gfc_trans_transfer): If the array reference in a ! read has a vector subscript, use gfc_conv_subref_array_arg to ! copy back the temporary. ! ! 2008-01-22 Tobias Burnus ! ! PR fortran/34848 ! * interface.c (compare_actual_formal): Fix adding type ! to missing_arg_type for absent optional arguments. ! ! 2008-01-22 Tobias Burnus ! ! PR fortran/34907 ! * parse.c (parse_spec): Change = into ==. ! ! 2008-01-22 Daniel Franke ! ! PR fortran/34915 ! * expr.c (check_elemental): Fix check for valid data types. ! ! 2008-01-22 Tobias Burnus ! ! PR fortran/34899 ! * scanner.c (load_line): Support continuation lines. ! * invoke.texi (-Wtabs): Document this. ! ! 2008-01-22 Paul Thomas ! ! PR fortran/34896 ! * module.c (read_module): Set use_rename attribute. ! ! 2007-01-21 Tobias Burnus ! ! PR fortran/34901 ! * interface.c (compare_parameter): Improved error message ! for arguments of same type and mismatched kinds. ! ! 2008-01-20 Paul Thomas ! ! PR fortran/34861 ! * resolve.c (resolve_entries): Do not do an array bounds check ! if the result symbols are the same. ! ! PR fortran/34854 ! * module.c (read_module) : Hide the symtree of the previous ! version of the symbol if this symbol is renamed. ! ! 2008-01-20 Paul Thomas ! ! PR fortran/34784 ! * array.c (gfc_check_constructor_type): Clear the expression ts ! so that the checking starts from the deepest level of array ! constructor. ! * primary.c (match_varspec): If an unknown type is changed to ! default character and the attempt to match a substring fails, ! change it back to unknown. ! ! PR fortran/34785 ! * trans-array.c (gfc_add_loop_ss_code) : If ss->string_length is ! NULL for an array constructor, use the cl.length expression to ! build it. ! (gfc_conv_array_parameter): Change call to gfc_evaluate_now to ! a tree assignment. ! ! 2008-01-19 Thomas Koenig ! ! PR fortran/34817 ! PR fortran/34838 ! * iresolve.c (gfc_resolve_all): Remove conversion of mask ! argument to kind=1 by removing call to resolve_mask_arg(). ! (gfc_resolve_any): Likewise. ! ! 2008-01-19 Tobias Burnus ! ! PR fortran/34760 ! * primary.c (match_variable): Handle FL_UNKNOWN without ! uneducated guessing. ! (match_variable): Improve error message. ! ! 2008-01-18 Tobias Burnus ! ! PR fortran/32616 ! * interface.c (get_expr_storage_size): Return storage size ! for array element designators. ! (compare_actual_formal): Reject unequal string sizes for ! assumed-shape dummy arguments. And fix error message for ! array-sections with vector subscripts. ! ! 2008-01-17 Jerry DeLisle ! ! PR fortran/34556 ! * simplify.c (is_constant_array_expr): New static function that returns ! true if the given expression is an array and is constant. ! (gfc_simplify_reshape): Use new function. ! ! 2008-01-17 H.J. Lu ! ! PR fortran/33375 ! * symbol.c (free_common_tree): Renamed to ... ! (gfc_free_common_tree): This. Remove static. ! (gfc_free_namespace): Updated. ! ! * gfortran.h (gfc_free_common_tree): New. ! ! * match.c (gfc_match_common): Call gfc_free_common_tree () with ! gfc_current_ns->common_root and set gfc_current_ns->common_root ! to NULL on syntax error. ! ! 2008-01-18 Richard Sandiford ! ! PR fortran/34686 ! * trans-expr.c (gfc_conv_function_call): Use proper ! type for returned character pointers. ! 2008-01-17 Paul Thomas ! PR fortran/34429 ! PR fortran/34431 ! PR fortran/34471 ! * decl.c : Remove gfc_function_kind_locus and ! gfc_function_type_locus. Add gfc_matching_function. ! (match_char_length): If matching a function and the length ! does not match, return MATCH_YES and try again later. ! (gfc_match_kind_spec): The same. ! (match_char_kind): The same. ! (gfc_match_type_spec): The same for numeric and derived types. ! (match_prefix): Rename as gfc_match_prefix. ! (gfc_match_function_decl): Except for function valued character ! lengths, defer applying kind, type and charlen info until the ! end of specification block. ! gfortran.h (gfc_statement): Add ST_GET_FCN_CHARACTERISTICS. ! parse.c (decode_specification_statement): New function. ! (decode_statement): Call it when a function has kind = -1. Set ! and reset gfc_matching function, as function statement is being ! matched. ! (match_deferred_characteristics): Simplify with a single call ! to gfc_match_prefix. Do appropriate error handling. In any ! case, make sure that kind = -1 is reset or corrected. ! (parse_spec): Call above on seeing ST_GET_FCN_CHARACTERISTICS. ! Throw an error if kind = -1 after last specification statement. ! parse.h : Prototype for gfc_match_prefix. ! 2008-01-16 Tobias Burnus ! PR fortran/34796 ! * interface.c (compare_parameter): Allow AS_DEFERRED array ! elements and reject attr.pointer array elemenents. ! (get_expr_storage_size): Return storage size of elements of ! assumed-shape and pointer arrays. ! 2008-01-15 Sebastian Pop ! * f95-lang.c (gfc_init_builtin_functions): Initialize GOMP builtins ! for flag_tree_parallelize_loops. ! 2008-01-15 Thomas Koenig ! PR libfortran/34671 ! * iresolve.c (gfc_resolve_all): Call resolve_mask_arg. ! (gfc_resolve_any): Likewise. ! (gfc_resolve_count): Likewise. Don't append kind of ! argument to function name. ! 2008-01-13 Tobias Burnus ! PR fortran/34665 ! * resolve.c (resolve_actual_arglist): For expressions, ! also check for assume-sized arrays. ! * interface.c (compare_parameter): Move F2003 character checks ! here, print error messages here, reject elements of ! assumed-shape array as argument to dummy arrays. ! (compare_actual_formal): Update for the changes above. ! 2008-01-13 Tobias Burnus ! PR fortran/34763 ! * decl.c (contained_procedure): Only check directly preceeding state. ! 2008-01-13 Tobias Burnus ! PR fortran/34759 ! * check.c (gfc_check_shape): Accept array ranges of ! assumed-size arrays. ! 2008-01-12 Jerry DeLisle ! PR fortran/34432 ! * match.c (gfc_match_name): Don't error if leading character is a '(', ! just return MATCH_NO. ! 2008-01-11 Jerry DeLisle ! PR fortran/34722 ! * trans-io.c (create_dummy_iostat): Commit the symbol. ! 2008-01-11 Paul Thomas ! PR fortran/34537 ! * simplify.c (gfc_simplify_transfer): Return NULL if the size ! of the element is unavailable and only assign character length ! to the result, if 'mold' is constant. ! 2008-01-10 Paul Thomas ! PR fortran/34396 ! * trans-array.c (gfc_trans_array_ctor_element): Use gfc_trans_string_copy ! to assign strings and perform bounds checks on the string length. ! (get_array_ctor_strlen): Remove bounds checking. ! (gfc_trans_array_constructor): Initialize string length checking. ! * trans-array.h : Add prototype for gfc_trans_string_copy. ! 2008-01-08 Richard Guenther ! PR fortran/34706 ! PR tree-optimization/34683 ! * trans-types.c (gfc_get_array_type_bounds): Use an array type ! with known size for accesses if that is known. ! 2008-01-08 Paul Thomas ! PR fortran/34476 ! * expr.c (find_array_element): Check that the array bounds are ! constant before using them. Use lower, as well as upper bound. ! (check_restricted): Allow implied index variable. ! 2008-01-08 Paul Thomas ! PR fortran/34681 ! * trans_array.c (gfc_trans_deferred_array): Do not null the ! data pointer on entering scope, nor deallocate it on leaving ! scope, if the symbol has the 'save' attribute. ! PR fortran/34704 ! * trans_decl.c (gfc_finish_var_decl): Derived types with ! allocatable components and an initializer must be TREE_STATIC. ! 2008-01-07 Paul Thomas ! PR fortran/34672 ! * module.c (write_generic): Rewrite completely. ! (write_module): Change call to write_generic. ! 2008-01-06 Jerry DeLisle ! PR fortran/34659 ! * scanner.c (load_line): Do not count ' ' as printable when checking for ! continuations. ! 2008-01-06 Paul Thomas ! PR fortran/34545 ! * module.c (load_needed): If the namespace has no proc_name ! give it the module symbol. ! 2008-01-06 Jerry DeLisle ! PR fortran/34387 ! * trans-expr.c (gfc_conv_missing_dummy): Use a temporary to type convert ! the dummy variable expression, test for NULL, and pass the variable ! address to the called function. ! 2007-01-06 Tobias Burnus ! PR fortran/34658 ! * match.c (gfc_match_common): Remove blank common in ! DATA BLOCK warning. ! * resolve.c (resolve_common_vars): New function. ! (resolve_common_blocks): Move checks to resolve_common_vars ! and invoke that function. ! (resolve_types): Call resolve_common_vars for blank commons. ! 2008-01-06 Tobias Burnus ! PR fortran/34655 ! * resolve.c (resolve_equivalence_derived): Reject derived types with ! default initialization if equivalenced with COMMON variable. ! 2008-01-06 Tobias Burnus ! PR fortran/34654 ! * io.c (check_io_constraints): Disallow unformatted I/O for ! internal units. ! 2008-01-06 Tobias Burnus ! PR fortran/34660 ! * resolve.c (resolve_formal_arglist): Reject dummy procedure in ! ELEMENTAL functions. ! 2008-01-06 Tobias Burnus ! PR fortran/34662 ! * interface.c (compare_actual_formal): Reject parameter ! actual to intent(out) dummy. ! 2008-01-04 Tobias Burnus ! PR fortran/34557 ! * primary.c (match_varspec): Gobble whitespace before ! checking for '('. --- 1,274 ---- ! 2009-04-21 Release Manager ! * GCC 4.4.0 released. ! 2009-04-08 Janus Weil ! PR fortran/38152 ! * trans-decl.c (gfc_get_symbol_decl): Correctly set decl location for ! procedure pointer decls. ! 2009-04-04 Paul Thomas Backport from mainline: ! PR fortran/39519 ! * parse.c (parse_derived): Do not break on finding pointer, ! allocatable or private components. ! 2009-04-03 Tobias Burnus ! PR fortran/39594 ! * resolve.c (resolve_common_vars): Add FL_VARIABLE to symbol ! if it is not a procedure pointer. ! * primary.c (match_actual_arg): Ditto. ! 2009-03-30 Jakub Jelinek ! * trans-types.c (gfc_sym_type, gfc_return_by_reference): For ! sym->attr.result check sym->ns->proc_name->attr.is_bind_c. ! 2009-03-18 Ralf Wildenhues ! * lang.opt: Unify help texts for -I, -Wconversion, -d, -fopenmp, ! and -fpreprocessed. ! 2009-03-06 Alexandre Oliva ! * simplify.c (gfc_simplify_transfer): Zero-initialize the ! buffer. ! 2009-02-27 Tobias Burnus ! PR fortran/39309 ! * module.c (read_md5_from_module_file): Add missing quote. ! 2009-02-27 Tobias Burnus ! PR fortran/39309 ! * module.c (read_md5_from_module_file): Include mod version ! in had-changed test. ! 2009-02-26 Paul Thomas ! PR fortran/39295 ! * interface.c (compare_type_rank_if): Return 1 if the symbols ! are the same and deal with external procedures where one is ! identified to be a function or subroutine by usage but the ! other is not. ! 2009-02-26 Paul Thomas ! PR fortran/39292 ! * trans-array.c (gfc_conv_array_initializer): Convert all ! expressions rather than ICEing. ! 2009-02-21 Thomas Koenig ! PR fortran/38914 ! * array.c (ref_dimen_size): Rename to gfc_ref_dimen_size, ! make global. Change function name in error messages. ! (ref_size): Change ref_dimen_size to gfc_ref_dimen_size. ! (gfc_array_ref_shape): Likewise. ! * gfortran.h: Add prototype for gfc_ref_dimen_size. ! * simplify.c (simplify_bound_dim): Add ref argument. ! If the reference isn't a full array, return one for ! the lower bound and the extent for the upper bound. ! (simplify_bound): For array sections, take as from the ! argument. Add reference to all to simplify_bound_dim. ! 2009-02-19 Daniel Franke ! * scanner.c (load_line): At end of line, skip '\r' without setting ! the truncation flag. ! 2009-02-18 Daniel Kraft ! * gfortran.texi: New chapter about compiler characteristics. ! (Compiler Characteristics): Document KIND type parameters here. ! 2009-02-18 Tobias Burnus ! * intrinsic.texi (MALLOC): Make example more portable. ! 2009-02-13 Mikael Morin ! PR fortran/38259 ! * module.c (gfc_dump_module,gfc_use_module): Add module ! version number. ! 2009-02-13 Paul Thomas ! PR fortran/36703 ! PR fortran/36528 ! * trans-expr.c (gfc_conv_function_val): Stabilize Cray-pointer ! function references to ensure that a valid expression is used. ! (gfc_conv_function_call): Pass Cray pointers to procedures. ! 2009-02-03 Jakub Jelinek * gfortranspec.c (lang_specific_driver): Update copyright notice dates. ! 2009-01-28 Paul Thomas ! PR fortran/38852 ! PR fortran/39006 ! * trans-intrinsic.c (gfc_conv_intrinsic_bound): Use the array ! descriptor ubound for UBOUND, when the array lbound == 1. ! 2009-01-27 Daniel Kraft ! PR fortran/38883 ! * trans-stmt.c (gfc_conv_elemental_dependencies): Create temporary ! for the real type needed to make it work for subcomponent-references. ! 2009-01-21 Daniel Kraft ! * trans-stmt.c (gfc_conv_elemental_dependencies): Cleaned up comment. ! 2009-01-20 Paul Thomas ! PR fortran/38907 ! * resolve.c (check_host_association): Remove the matching to ! correct an incorrect host association and use manipulation of ! the expression instead. ! 2009-01-20 Tobias Burnus ! * invoke.texi (RANGE): RANGE also takes INTEGER arguments. ! 2009-01-19 Mikael Morin ! PR fortran/38859 ! * simplify.c (simplify_bound): Don't use array specification ! if variable or component has subsequent references. ! 2009-01-17 Paul Thomas ! PR fortran/38657 ! * module.c (write_common_0): Add argument 'this_module' and ! check that non-use associated common blocks are written first. ! (write_common): Call write_common_0 twice, once with true and ! then with false. ! 2009-01-17 Paul Thomas ! PR fortran/34955 ! * trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): Has ! been absorbed into gfc_conv_intrinsic_transfer. All ! references to it in trans-intrinsic.c have been changed ! accordingly. PR fixed by using a temporary for scalar ! character transfer, when the source is shorter than the ! destination. ! 2009-01-17 Paul Thomas ! PR fortran/38657 ! * module.c (write_common_0): Revert patch of 2009-01-05. ! 2009-01-16 Janus Weil ! PR fortran/38152 ! * expr.c (gfc_check_pointer_assign): Allow use-associated procedure ! pointers as lvalue. ! * trans-decl.c (get_proc_pointer_decl,gfc_create_module_variable): ! Enable procedure pointers as module variables. ! 2009-01-14 Steven G. Kargl ! * ChangeLog-2007: Clean out svn merge droppings. ! 2009-01-10 Paul Thomas ! PR fortran/38763 ! * target-memory.c (encode_derived): Encode NULL. ! 2009-01-10 Paul Thomas ! PR fortran/38765 ! * resolve.c (check_host_association): Use the symtree name to ! search for a potential contained procedure, since this is the ! name by which it would be referenced. ! 2009-01-06 Thomas Koenig ! PR fortran/38220 ! * interface.c (gfc_procedure_use): Don't warn about functions ! from ISO_C_BINDING. ! * symbol.c (generate_isocbinding_symbol): Mark c_loc and ! c_funloc as pure. ! 2009-01-05 Paul Thomas ! PR fortran/38657 ! * module.c (write_common_0): Use the name of the symtree rather ! than the common block, to determine if the common has been ! written. ! 2009-01-05 Daniel Franke ! PR fortran/37159 ! * check.c (gfc_check_random_seed): Added size check for GET ! dummy argument, reworded error messages to follow common pattern. ! 2009-01-05 Thomas Koenig ! PR fortran/38672 ! * trans-types.c (gfc_get_derived_type): Check for the ! presence of derived->ns->proc_name before ! accessing derived->ns->proc_name->attr.flavor . ! * resolve.c (resolve_symbol): Likewise. ! 2009-01-05 Paul Thomas ! PR fortran/38665 ! * gfortran.h : Add bit to gfc_expr 'user_operator' ! * interface.c (gfc_extend_expr): Set the above if the operator ! is substituted by a function. ! * resolve.c (check_host_association): Return if above is set. ! 2009-01-04 Mikael Morin ! PR fortran/35681 ! * ChangeLog-2008: Fix function name. ! PR fortran/38487 ! * dependency.c (gfc_check_argument_var_dependency): ! Move the check for pointerness inside the if block ! so that it doesn't affect the return value. ! PR fortran/38669 ! * trans-stmt.c (gfc_trans_call): ! Add the dependency code after the loop bounds calculation one. ! 2009-01-04 Daniel Franke ! * intrinsic.c (do_simplify): Removed already implemented TODO. ! 2009-01-04 Daniel Franke ! PR fortran/38718 ! * simplify.c (gfc_simplify_merge): New. ! * intrinsic.h (gfc_simplify_merge): New prototype. ! * intrinsic.c (add_functions): Added simplification for MERGE. ! 2009-01-04 Mikael Morin ! PR fortran/38536 ! * gfortran.h (gfc_is_data_pointer): Added prototype ! * resolve.c (gfc_iso_c_func_interface): ! Use gfc_is_data_pointer to test for pointer attribute. ! * dependency.c (gfc_is_data_pointer): ! Support pointer-returning functions. ! 2009-01-03 Daniel Franke ! * symbol.c (save_symbol): Don't SAVE function results. ! 2009-01-03 Paul Thomas ! PR fortran/38594 ! * resolve.c (resolve_call): When searching for proper host ! association, use symtree rather than symbol. For everything ! except generic subroutines, substitute the symtree in the call ! rather than the symbol. diff -Nrcpad gcc-4.3.3/gcc/fortran/ChangeLog-2004 gcc-4.4.0/gcc/fortran/ChangeLog-2004 *** gcc-4.3.3/gcc/fortran/ChangeLog-2004 Sun Jan 1 17:04:47 2006 --- gcc-4.4.0/gcc/fortran/ChangeLog-2004 Fri Sep 5 11:07:45 2008 *************** *** 2169,2175 **** * symbol.c (gfc_add_common): Disable checks to work around other more fundamental inadequacies. ! 2004-05-22 Tobias Schlter * trans-decl.c (gfc_get_extern_function_decl): Set DECL_IS_PURE only for functions. --- 2169,2175 ---- * symbol.c (gfc_add_common): Disable checks to work around other more fundamental inadequacies. ! 2004-05-22 Tobias Schlüter * trans-decl.c (gfc_get_extern_function_decl): Set DECL_IS_PURE only for functions. *************** *** 2377,2383 **** * decl.c (variable_decl): Always apply default initializer. ! 2004-05-08 Tobias Schlter PR fortran/15206 * trans-intrinsic.c (gfc_conv_intrinsic_rrspacing): Fixed to --- 2377,2383 ---- * decl.c (variable_decl): Always apply default initializer. ! 2004-05-08 Tobias Schlüter PR fortran/15206 * trans-intrinsic.c (gfc_conv_intrinsic_rrspacing): Fixed to *************** *** 2451,2457 **** Remove "set DEVELOPMENT". (Compiling GFORTRAN): Remove. ! 2004-05-09 Tobias Schlter * array.c (match_subscript, match_array_ref): Add comments explaining argument 'init'. --- 2451,2457 ---- Remove "set DEVELOPMENT". (Compiling GFORTRAN): Remove. ! 2004-05-09 Tobias Schlüter * array.c (match_subscript, match_array_ref): Add comments explaining argument 'init'. *************** *** 2461,2480 **** * primary.c (match_digits, match_integer_constant): Add comment explaining signflag. ! 2004-05-01 Tobias Schlter PR fortran/13940 * primary.c: Include system.h and flags.h, needed for pedantic. (match_boz_constant): Allow "x" for hexadecimal constants, warn if pedantic is set. ! 2004-05-01 Tobias Schlter PR fortran/13940 * match.c (match_data_constant): Handle case where gfc_find_symbol sets sym to NULL ! 2004-04-28 Tobias Schlter * Make-lang.in (f95-lang.o, trans-intrinsic.o): Add missing dependency on mathbuiltins.def --- 2461,2480 ---- * primary.c (match_digits, match_integer_constant): Add comment explaining signflag. ! 2004-05-01 Tobias Schlüter PR fortran/13940 * primary.c: Include system.h and flags.h, needed for pedantic. (match_boz_constant): Allow "x" for hexadecimal constants, warn if pedantic is set. ! 2004-05-01 Tobias Schlüter PR fortran/13940 * match.c (match_data_constant): Handle case where gfc_find_symbol sets sym to NULL ! 2004-04-28 Tobias Schlüter * Make-lang.in (f95-lang.o, trans-intrinsic.o): Add missing dependency on mathbuiltins.def *************** *** 2488,2494 **** * gfortranspec.c: Do not include multilib.h. ! 2004-04-24 Tobias Schlter * trans-intrinsic.c: Fix comment, this is not trans-expr.c. Add 2004 to copyright years. --- 2488,2494 ---- * gfortranspec.c: Do not include multilib.h. ! 2004-04-24 Tobias Schlüter * trans-intrinsic.c: Fix comment, this is not trans-expr.c. Add 2004 to copyright years. diff -Nrcpad gcc-4.3.3/gcc/fortran/ChangeLog-2005 gcc-4.4.0/gcc/fortran/ChangeLog-2005 *** gcc-4.3.3/gcc/fortran/ChangeLog-2005 Sun Jan 1 17:04:47 2006 --- gcc-4.4.0/gcc/fortran/ChangeLog-2005 Fri Sep 5 11:07:45 2008 *************** *** 21,27 **** PR fortran/25587 * trans-io.c (gfc_build_st_parameter): Correct off by one error. ! 2005-12-28 Rafael vila de Espndola * Make-lang.in: Remove distdir from comment. --- 21,27 ---- PR fortran/25587 * trans-io.c (gfc_build_st_parameter): Correct off by one error. ! 2005-12-28 Rafael Ávila de Espíndola * Make-lang.in: Remove distdir from comment. *************** *** 399,409 **** as actual arguments to ASSOCIATED. Moved a misplaced comment. ! 2005-12-07 Rafael vila de Espndola * Make-lang.in (fortran.all.build, fortran.install-normal): Remove. ! 2005-12-07 Rafael vila de Espndola * Make-lang.in: Remove all dependencies on s-gtype, except for gt-fortran-trans.h. --- 399,409 ---- as actual arguments to ASSOCIATED. Moved a misplaced comment. ! 2005-12-07 Rafael Ávila de Espíndola * Make-lang.in (fortran.all.build, fortran.install-normal): Remove. ! 2005-12-07 Rafael Ávila de Espíndola * Make-lang.in: Remove all dependencies on s-gtype, except for gt-fortran-trans.h. diff -Nrcpad gcc-4.3.3/gcc/fortran/ChangeLog-2006 gcc-4.4.0/gcc/fortran/ChangeLog-2006 *** gcc-4.3.3/gcc/fortran/ChangeLog-2006 Mon Jan 1 19:22:09 2007 --- gcc-4.4.0/gcc/fortran/ChangeLog-2006 Fri Sep 5 11:07:45 2008 *************** *** 112,118 **** the nullifying of intent(out) arguments rather than the backend declaration. ! 2006-12-20 Tobias Schlter PR fortran/25392 * trans-stmt.c (gfc_trans_return): Fix comment formatting. --- 112,118 ---- the nullifying of intent(out) arguments rather than the backend declaration. ! 2006-12-20 Tobias Schlüter PR fortran/25392 * trans-stmt.c (gfc_trans_return): Fix comment formatting. *************** *** 215,221 **** function declarations to match the library changes. Mark allocation functions with DECL_IS_MALLOC. ! 2006-12-12 Tobias Schlter * trans-expr.c (gfc_conv_substring): Check for empty substring. --- 215,221 ---- function declarations to match the library changes. Mark allocation functions with DECL_IS_MALLOC. ! 2006-12-12 Tobias Schlüter * trans-expr.c (gfc_conv_substring): Check for empty substring. *************** *** 669,675 **** * trans-expr.c (gfc_conv_expr_reference): Set TREE_STATIC on the new CONST_DECL. ! 2006-11-11 Tobias Schlter * array.c: Add 2006 to copyright years. * data.c: Same. --- 669,675 ---- * trans-expr.c (gfc_conv_expr_reference): Set TREE_STATIC on the new CONST_DECL. ! 2006-11-11 Tobias Schlüter * array.c: Add 2006 to copyright years. * data.c: Same. *************** *** 969,975 **** * expr.c (simplify_parameter_variable): Keep rank of original expression. ! 2006-10-23 Rafael Avila de Espindola * Make-lang.in (f951$(exeext)): Depend on and link with attribs.o. * trans.h (builtin_function): Rename to gfc_builtin_function. --- 969,975 ---- * expr.c (simplify_parameter_variable): Keep rank of original expression. ! 2006-10-23 Rafael Ávila de Espíndola * Make-lang.in (f951$(exeext)): Depend on and link with attribs.o. * trans.h (builtin_function): Rename to gfc_builtin_function. *************** *** 1566,1572 **** PR fortran/29097 * scanner.c (include_line): Handle conditional include. ! 2006-09-25 Tobias Schluter PR fortran/21203 * error.c (show_loci): No need to risk an ICE to output a --- 1566,1572 ---- PR fortran/29097 * scanner.c (include_line): Handle conditional include. ! 2006-09-25 Tobias Schlüter PR fortran/21203 * error.c (show_loci): No need to risk an ICE to output a *************** *** 1599,1605 **** * iresolve.c (resolve_spread): Build shape for result if the source shape is available and dim and ncopies are constants. ! 2006-09-18 Tobias Schlter PR fortran/28817 PR fortran/21918 --- 1599,1605 ---- * iresolve.c (resolve_spread): Build shape for result if the source shape is available and dim and ncopies are constants. ! 2006-09-18 Tobias Schlüter PR fortran/28817 PR fortran/21918 *************** *** 2121,2127 **** * intrinsic.texi: Document new intrinsics. ! 2006-07-01 Tobias Schlter PR fortran/19259 * parse.c (next_free): Error out on line starting with semicolon. --- 2121,2127 ---- * intrinsic.texi: Document new intrinsics. ! 2006-07-01 Tobias Schlüter PR fortran/19259 * parse.c (next_free): Error out on line starting with semicolon. *************** *** 2728,2734 **** * parse.c (next_statement): Add check to avoid an ICE when gfc_current_locus.lb is not set. ! 2006-05-07 Tobias Schlter PR fortran/27457 * match.c (match_case_eos): Error out on garbage following --- 2728,2734 ---- * parse.c (next_statement): Add check to avoid an ICE when gfc_current_locus.lb is not set. ! 2006-05-07 Tobias Schlüter PR fortran/27457 * match.c (match_case_eos): Error out on garbage following *************** *** 2749,2755 **** -fall-intrinsics is used. (gfc_handle_option): Permit -Wno-nonstd-intrinsics. ! 2006-05-04 Tobias Schlter * simplify.c (ascii_table): Fix wrong entry. --- 2749,2755 ---- -fall-intrinsics is used. (gfc_handle_option): Permit -Wno-nonstd-intrinsics. ! 2006-05-04 Tobias Schlüter * simplify.c (ascii_table): Fix wrong entry. *************** *** 3357,3363 **** * module.c (read_module): Remove redundant code lines. ! 2006-02-20 Rafael vila de Espndola * Make-lang.in (FORTRAN): Remove (.PHONY): Remove F95 and f95. Add fortran --- 3357,3363 ---- * module.c (read_module): Remove redundant code lines. ! 2006-02-20 Rafael Ávila de Espíndola * Make-lang.in (FORTRAN): Remove (.PHONY): Remove F95 and f95. Add fortran *************** *** 3456,3462 **** PR fortran/26054 * options.c: Do not warn for Fortran 2003 features by default. ! 2006-02-15 Tobias Schlter * check.c: Update copyright years. --- 3456,3462 ---- PR fortran/26054 * options.c: Do not warn for Fortran 2003 features by default. ! 2006-02-15 Tobias Schlüter * check.c: Update copyright years. *************** *** 3479,3485 **** to check dim argument. (check_reduction): Likewise. ! 2006-02-14 Tobias Schlter PR fortran/26277 * io.c (match_ltag): Mark label as referenced. --- 3479,3485 ---- to check dim argument. (check_reduction): Likewise. ! 2006-02-14 Tobias Schlüter PR fortran/26277 * io.c (match_ltag): Mark label as referenced. *************** *** 3930,3943 **** are set. ! 2006-02-10 Tobias Schlter PR fortran/14771 * arith.c (eval_intrinsic): Accept INTRINSIC_PARENTHESES. * expr.c (check_intrinsic_op): Likewise. * module.c (mio_expr): Likewise. ! 2006-02-09 Tobias Schlter * dump-parse-tree.c: Update copyright years. * matchexp.c: Likewise. --- 3930,3943 ---- are set. ! 2006-02-10 Tobias Schlüter PR fortran/14771 * arith.c (eval_intrinsic): Accept INTRINSIC_PARENTHESES. * expr.c (check_intrinsic_op): Likewise. * module.c (mio_expr): Likewise. ! 2006-02-09 Tobias Schlüter * dump-parse-tree.c: Update copyright years. * matchexp.c: Likewise. *************** *** 4319,4325 **** is_aliased_array and convert it to a temporary and back again using gfc_conv_aliased_arg. ! 2006-01-19 Tobias Schlter * gfortranspec.c: Update copyright years. * trans.c: Likewise. --- 4319,4325 ---- is_aliased_array and convert it to a temporary and back again using gfc_conv_aliased_arg. ! 2006-01-19 Tobias Schlüter * gfortranspec.c: Update copyright years. * trans.c: Likewise. *************** *** 4330,4336 **** * trans-stmt.h: Likewise. * trans-types.c: Likewise. ! 2006-01-18 Tobias Schlter PR fortran/18540 PR fortran/18937 --- 4330,4336 ---- * trans-stmt.h: Likewise. * trans-types.c: Likewise. ! 2006-01-18 Tobias Schlüter PR fortran/18540 PR fortran/18937 *************** *** 4375,4381 **** argument checking. Replace strcmp's with comparisons with generic codes. ! 2006-01-16 Rafael vila de Espndola * gfortranspec.c (lang_specific_spec_functions): Remove. --- 4375,4381 ---- argument checking. Replace strcmp's with comparisons with generic codes. ! 2006-01-16 Rafael Ávila de Espíndola * gfortranspec.c (lang_specific_spec_functions): Remove. *************** *** 4412,4418 **** * trans.c (gfc_add_expr_to_block): Do not fold tcc_statement nodes. ! 2006-01-11 Tobias Schlter * parse.c (next_fixed): Remove superfluous string concatenation. --- 4412,4418 ---- * trans.c (gfc_add_expr_to_block): Do not fold tcc_statement nodes. ! 2006-01-11 Tobias Schlüter * parse.c (next_fixed): Remove superfluous string concatenation. diff -Nrcpad gcc-4.3.3/gcc/fortran/ChangeLog-2007 gcc-4.4.0/gcc/fortran/ChangeLog-2007 *** gcc-4.3.3/gcc/fortran/ChangeLog-2007 Wed Jan 2 17:54:50 2008 --- gcc-4.4.0/gcc/fortran/ChangeLog-2007 Wed Jan 14 21:22:53 2009 *************** *** 87,93 **** * module.c (read_module): Check sym->module is there before using it in a string comparison. - >>>>>>> .r131138 2007-12-20 Tobias Burnus PR fortran/34482 --- 87,92 ---- *************** *** 870,876 **** (gfc_dep_resolver): Correct the logic for substrings so that overlapping arrays are handled correctly. ! 2007-10-28 Tobias Schlter PR fortran/32147 * module.c (write_symbol): Fix whitespace. --- 869,875 ---- (gfc_dep_resolver): Correct the logic for substrings so that overlapping arrays are handled correctly. ! 2007-10-28 Tobias Schlüter PR fortran/32147 * module.c (write_symbol): Fix whitespace. *************** *** 985,991 **** namespaces and start search for symbol in current namespace. 2007-10-18 Paul Thomas ! Dominique d'Humieres PR fortran/33733 * simplify.c (gfc_simplify_transfer): Return null if the source --- 984,990 ---- namespaces and start search for symbol in current namespace. 2007-10-18 Paul Thomas ! Dominique d'Humières PR fortran/33733 * simplify.c (gfc_simplify_transfer): Return null if the source *************** *** 1028,1034 **** * resolve.c (check_dimension): Fix dimension-type switch; improve error message. ! 2007-10-13 Tobias Schlter Paul Thomas PR fortran/33254 --- 1027,1033 ---- * resolve.c (check_dimension): Fix dimension-type switch; improve error message. ! 2007-10-13 Tobias Schlüter Paul Thomas PR fortran/33254 *************** *** 1055,1061 **** PR fortran/33636 * expr.c (find_array_section): Check for constructor constantness. ! 2007-10-08 Tobias Schlter PR fortran/33689 * resolve.c (gfc_resolve_expr): Fix indentation. --- 1054,1060 ---- PR fortran/33636 * expr.c (find_array_section): Check for constructor constantness. ! 2007-10-08 Tobias Schlüter PR fortran/33689 * resolve.c (gfc_resolve_expr): Fix indentation. *************** *** 1069,1075 **** * mathbuiltins.def (GAMMA): Change function name to "tgamma" instad of "gamma". ! 2007-10-07 Tobias Schlter PR fortran/20851 * expr.c (check_inquiry): Typo fix in error message. --- 1068,1074 ---- * mathbuiltins.def (GAMMA): Change function name to "tgamma" instad of "gamma". ! 2007-10-07 Tobias Schlüter PR fortran/20851 * expr.c (check_inquiry): Typo fix in error message. *************** *** 1085,1095 **** * simplify.c (range_check): Return gfc_bad_expr if incoming expression is NULL. ! 2007-10-06 Tobias Schlter * simplify.c (gfc_simplify_size): Fix typo. ! 2007-10-06 Tobias Schlter PR fortran/25076 * resolve.c (gfc_find_forall_index): Move towards top, --- 1084,1094 ---- * simplify.c (range_check): Return gfc_bad_expr if incoming expression is NULL. ! 2007-10-06 Tobias Schlüter * simplify.c (gfc_simplify_size): Fix typo. ! 2007-10-06 Tobias Schlüter PR fortran/25076 * resolve.c (gfc_find_forall_index): Move towards top, *************** *** 1148,1154 **** * gfortran.h (gfc_linebuf): Add dbg_emitted field. (gfc_define_undef_line): New prototype. ! 2007-10-04 Tobias Schlter PR fortran/33626 * resolve.c (resolve_operator): Always copy the type for --- 1147,1153 ---- * gfortran.h (gfc_linebuf): Add dbg_emitted field. (gfc_define_undef_line): New prototype. ! 2007-10-04 Tobias Schlüter PR fortran/33626 * resolve.c (resolve_operator): Always copy the type for *************** *** 1166,1172 **** * trans-decl.c (build_function_decl): Set "externally_visible" attribute on the MAIN program decl. ! 2007-10-03 Tobias Schlter PR fortran/33198 * resolve.c (has_default_initializer): Move to top. Make bool. --- 1165,1171 ---- * trans-decl.c (build_function_decl): Set "externally_visible" attribute on the MAIN program decl. ! 2007-10-03 Tobias Schlüter PR fortran/33198 * resolve.c (has_default_initializer): Move to top. Make bool. *************** *** 1239,1245 **** * module.c (mio_expr): Avoid -Wcast-qual warning. ! 2007-09-27 Tobias Schlter * arith.c (reduce_binary_aa): Fix capitalization. * check.c (gfc_check_dot_product): Likewise. --- 1238,1244 ---- * module.c (mio_expr): Avoid -Wcast-qual warning. ! 2007-09-27 Tobias Schlüter * arith.c (reduce_binary_aa): Fix capitalization. * check.c (gfc_check_dot_product): Likewise. *************** *** 1264,1270 **** PR fortran/30780 * invoke.texi: Add note to -ffpe-trap option. Fix typos. ! 2007-09-23 Tobias Schlter PR fortran/33269 * io.c (check_format_string): Move NULL and constant checks into --- 1263,1269 ---- PR fortran/30780 * invoke.texi: Add note to -ffpe-trap option. Fix typos. ! 2007-09-23 Tobias Schlüter PR fortran/33269 * io.c (check_format_string): Move NULL and constant checks into *************** *** 1373,1379 **** reduce_binary_aa): Call ourselves recursively if an element of the constructor is itself a constant array. ! 2007-09-20 Tobias Schlter * io.c (resolve_tag_format): New function using code split out and simplified from ... --- 1372,1378 ---- reduce_binary_aa): Call ourselves recursively if an element of the constructor is itself a constant array. ! 2007-09-20 Tobias Schlüter * io.c (resolve_tag_format): New function using code split out and simplified from ... *************** *** 1663,1669 **** * match.c (gfc_match_strings): Delete unused function. * match.h (gfc_match_strings): Delete prototype. ! 2007-09-02 Tobias Schluter * dump-parse-tree.c (show_char_const): New function. (gfc_show_expr): Use it. --- 1662,1668 ---- * match.c (gfc_match_strings): Delete unused function. * match.h (gfc_match_strings): Delete prototype. ! 2007-09-02 Tobias Schlüter * dump-parse-tree.c (show_char_const): New function. (gfc_show_expr): Use it. *************** *** 1879,1885 **** runtime error checking. 2007-08-22 Roger Sayle ! Tobias Schlter * match.c (intrinsic_operators): Delete. (gfc_match_intrinsic_op): Rewrite matcher to avoid calling --- 1878,1884 ---- runtime error checking. 2007-08-22 Roger Sayle ! Tobias Schlüter * match.c (intrinsic_operators): Delete. (gfc_match_intrinsic_op): Rewrite matcher to avoid calling *************** *** 2897,2903 **** dummy arguments, tell middle-end not to emit additional warnings. 2007-07-08 Daniel Franke ! Tobias Schlter PR fortran/17711 * gfortran.h (gfc_intrinsic_op): Added INTRINSIC_EQ_OS, --- 2896,2902 ---- dummy arguments, tell middle-end not to emit additional warnings. 2007-07-08 Daniel Franke ! Tobias Schlüter PR fortran/17711 * gfortran.h (gfc_intrinsic_op): Added INTRINSIC_EQ_OS, *************** *** 3430,3436 **** the total offset to the field. * target-memory.h : Add prototype for gfc_merge_initializers. ! 2007-06-11 Rafael Avila de Espindola * trans-types.c (gfc_signed_type): Remove. * trans-types.h (gfc_signed_type): Remove. --- 3429,3435 ---- the total offset to the field. * target-memory.h : Add prototype for gfc_merge_initializers. ! 2007-06-11 Rafael Ávila de Espíndola * trans-types.c (gfc_signed_type): Remove. * trans-types.h (gfc_signed_type): Remove. *************** *** 3839,3845 **** * trans-expr.c (gfc_conv_substring): Evaluate substring bounds only once. ! 2007-05-14 Rafael Avila de Espindola * f95-lang.c (LANG_HOOKS_UNSIGNED_TYPE): Remove. * trans-intrinsic.c (gfc_conv_intrinsic_ishft): Use unsigned_type_for --- 3838,3844 ---- * trans-expr.c (gfc_conv_substring): Evaluate substring bounds only once. ! 2007-05-14 Rafael Ávila de Espíndola * f95-lang.c (LANG_HOOKS_UNSIGNED_TYPE): Remove. * trans-intrinsic.c (gfc_conv_intrinsic_ishft): Use unsigned_type_for *************** *** 4392,4398 **** * gfortran.texi: Add a section for the %VAL, %REF and %LOC extensions. ! 2007-03-30 Rafael Avila de Espindola * trans-types.c (gfc_signed_or_unsigned_type): Remove. (gfc_unsigned_type): Use get_signed_or_unsigned_type instead of --- 4391,4397 ---- * gfortran.texi: Add a section for the %VAL, %REF and %LOC extensions. ! 2007-03-30 Rafael Ávila de Espíndola * trans-types.c (gfc_signed_or_unsigned_type): Remove. (gfc_unsigned_type): Use get_signed_or_unsigned_type instead of diff -Nrcpad gcc-4.3.3/gcc/fortran/ChangeLog-2008 gcc-4.4.0/gcc/fortran/ChangeLog-2008 *** gcc-4.3.3/gcc/fortran/ChangeLog-2008 Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/gcc/fortran/ChangeLog-2008 Sun Jan 4 19:12:16 2009 *************** *** 0 **** --- 1,4135 ---- + 2008-12-31 Daniel Franke + + * check.c (dim_rank_check): Fixed checking of dimension argument + if array is of type EXPR_ARRAY. + + 2008-12-22 Paul Thomas + + PR fortran/38602 + * trans-decl.c (init_intent_out_dt): Allow for optional args. + + 2008-12-21 Jerry DeLisle + + PR fortran/38398 + * io.c: Add error checks for g0 formatting and provide adjustment of + error loci for improved error messages. + + 2008-12-21 Arjen Markus + Daniel Kraft + + PR fortran/37605 + * gfortran.texi: Fixed some typos and some minor style improvements. + * intrinsic.texi: Some clarifications and typo-fixes. + * invoke.texi: Better documenation of the behaviour of the + -fdefault-*-8 options and some other fixes. + + 2008-12-18 Daniel Kraft + + PR fortran/31822 + * gfortran.h (gfc_check_same_strlen): Made public. + * trans.h (gfc_trans_same_strlen_check): Made public. + * check.c (gfc_check_same_strlen): Made public and adapted error + message output to be useful not only for intrinsics. + (gfc_check_merge): Adapt to gfc_check_same_strlen change. + * expr.c (gfc_check_pointer_assign): Use gfc_check_same_strlen for + string length compile-time check. + * trans-expr.c (gfc_trans_pointer_assignment): Add runtime-check for + equal string lengths using gfc_trans_same_strlen_check. + * trans-intrinsic.c (gfc_trans_same_strlen_check): Renamed and made + public from conv_same_strlen_check. + (gfc_conv_intrinsic_merge): Adapted accordingly. + + 2008-12-17 Daniel Kraft + + PR fortran/38137 + * trans-intrinsic.c (conv_same_strlen_check): New method. + (gfc_conv_intrinsic_merge): Call it here to actually do the check. + + 2008-12-15 Mikael Morin + + PR fortran/38487 + * dependency.c (gfc_is_data_pointer): New function. + (gfc_check_argument_var_dependency): Disable the warning + in the pointer case. + (gfc_check_dependency): Use gfc_is_data_pointer. + + 2008-12-15 Mikael Morin + + PR fortran/38113 + * error.c (show_locus): Start counting columns at 0. + * primary.c (match_actual_arg): Eat spaces + before copying the current locus. + (match_variable): Copy the locus before matching. + + 2008-12-14 Paul Thomas + + PR fortran/35937 + * trans-expr.c (gfc_finish_interface_mapping): Fold convert the + character length to gfc_charlen_type_node. + + 2008-12-12 Daniel Franke + + PR fortran/36355 + * check.c (gfc_check_matmul): Fixed error message for invalid + types to correctly identify the offending argument, added check + for mismatching types. + + 2008-12-11 Richard Guenther + + * Make-lang.in (install-finclude-dir): Use correct mode argument + for mkinstalldirs. + + 2008-12-09 Daniel Franke + + PR fortran/36376 + PR fortran/37468 + * lang-specs.h: Pass on -i* options to f951 to (probably) report + them as unknown. Duplicate gcc.c (cpp_options), but omit + -fpch-preprocess on -save-temps. + + 2008-12-09 Daniel Franke + + PR fortran/36457 + * lang.opt: Added option idirafter. + * cpp.h (gfc_cpp_add_include_path_after): New prototype. + * cpp.c (gfc_cpp_handle_option): Recognize and handle OPT_dirafter. + (gfc_cpp_add_include_path_after): New, adds user-defined search path + after any other paths. + * invoke.texi (idirafter): New. + (no-range-check): Fixed entry in option-index. + + 2008-12-09 Mikael Morin + + PR fortran/37469 + * expr.c (find_array_element): Simplify array bounds. + Assert that both bounds are constant expressions. + + 2008-12-09 Mikael Morin + + PR fortran/35983 + * trans-expr.c (gfc_trans_subcomponent_assign): + Add se's pre and post blocks to current block. + (gfc_trans_structure_assign): Remove specific handling + of C_NULL_PTR and C_NULL_FUNPTR. + + 2008-12-06 Jerry DeLisle + + PR fortran/38425 + * io.c (check_io_constraints): Check constraints on REC=, POS=, and + internal unit with POS=. Fix punctuation on a few error messages. + + 2008-12-06 Janus Weil + + PR fortran/38415 + * expr.c (gfc_check_pointer_assign): Added a check for abstract + interfaces in procedure pointer assignments, removed check involving + gfc_compare_interfaces until PR38290 is fixed completely. + + 2008-12-05 Jerry DeLisle + + PR fortran/38291 + * io.c (match_dt_element): Use dt->pos in matcher. + (gfc_free_dt): Free dt->pos after use. + (gfc_resolve_dt): Use dt->pos in resolution of stream position tag. + + 2008-12-05 Sebastian Pop + + PR bootstrap/38262 + * Make-lang.in (f951): Add BACKENDLIBS, remove GMPLIBS. + + 2008-12-02 Jakub Jelinek + Diego Novillo + + * Make-lang.in (install-finclude-dir): Use mkinstalldirs + and don't remove the finclude directory beforehand. + + 2008-12-02 Janus Weil + + PR fortran/36704 + PR fortran/38290 + * decl.c (match_result): Result may be a standard variable or a + procedure pointer. + * expr.c (gfc_check_pointer_assign): Additional checks for procedure + pointer assignments. + * primary.c (gfc_match_rvalue): Bugfix for procedure pointer + assignments. + * resolve.c (resolve_function): Check for attr.subroutine. + * symbol.c (check_conflict): Addtional checks for RESULT statements. + * trans-types.c (gfc_sym_type,gfc_get_function_type): Support procedure + pointers as function result. + + 2008-12-01 Mikael Morin + + PR fortran/38252 + * parse.c (parse_spec): Skip statement order check in case + of a CONTAINS statement. + + 2008-11-30 Daniel Kraft + + PR fortran/37779 + * gfortran.h (struct gfc_entry_list): Fixed typo in comment. + * resolve.c (is_illegal_recursion): New method. + (resolve_procedure_expression): Use new is_illegal_recursion instead of + direct check and handle function symbols correctly. + (resolve_actual_arglist): Removed useless recursion check. + (resolve_function): Use is_illegal_recursion instead of direct check. + (resolve_call): Ditto. + + 2008-11-29 Eric Botcazou + + * trans-array.c (gfc_conv_array_parameter): Guard union access. + + 2008-11-29 Janus Weil + Mikael Morin + + PR fortran/38289 + PR fortran/38290 + * decl.c (match_procedure_decl): Handle whitespaces. + * resolve.c (resolve_specific_s0): Bugfix in check for intrinsic + interface. + + 2008-11-25 H.J. Lu + + * module.c (gfc_dump_module): Report error on unlink only if + errno != ENOENT. + + 2008-11-25 Mikael Morin + + PR fortran/36463 + * expr.c (replace_symbol): Don't replace the symtree + if the expresion is an intrinsic function. Don't create + non-existent symtrees. Use symbol's name instead of symtree's, + different in case of module procedure dummy arguments. + + 2008-11-25 Jan Kratochvil + + PR fortran/38248 + * module.c (gfc_dump_module): Check rename/unlink syscalls errors. + + 2008-11-25 Eric Botcazou + + PR fortran/37319 + * parse.c (match_deferred_characteristics): Make sure 'name' is + initialized before reading it. + + 2008-11-24 Jerry DeLisle + + PR fortran/37803 + * arith.c (gfc_check_real_range): Add mpfr_check_range. + * simplify.c (gfc_simplify_nearest): Add mpfr_check_range. + + 2008-11-24 Mikael Morin + + PR fortran/38184 + * simplify.c (is_constant_array_expr): Return true instead of false + if the array constructor is empty. + + 2008-11-24 Daniel Kraft + + PR fortran/37779 + * resolve.c (resolve_procedure_expression): New method. + (resolve_variable): Call it. + (resolve_actual_arglist): Call gfc_resolve_expr for procedure arguments. + + 2008-11-24 Paul Thomas + + PR fortran/34820 + * trans-expr.c (gfc_conv_function_call): Remove all code to + deallocate intent out derived types with allocatable + components. + (gfc_trans_assignment_1): An assignment from a scalar to an + array of derived types with allocatable components, requires + a deep copy to each array element and deallocation of the + converted rhs expression afterwards. + * trans-array.c : Minor whitespace. + * trans-decl.c (init_intent_out_dt): Add code to deallocate + allocatable components of derived types with intent out. + (generate_local_decl): If these types are unused, set them + referenced anyway but allow the uninitialized warning. + + PR fortran/34143 + * trans-expr.c (gfc_trans_subcomponent_assign): If a conversion + expression has a null data pointer argument, nullify the + allocatable component. + + PR fortran/32795 + * trans-expr.c (gfc_trans_subcomponent_assign): Only nullify + the data pointer if the source is not a variable. + + 2008-11-23 Paul Thomas + + PR fortran/37735 + * trans-array.c (structure_alloc_comps): Do not duplicate the + descriptor if this is a descriptorless array! + + 2008-11-12 Tobias Burnus + + PR fortran/38160 + * trans-types.c (gfc_validate_c_kind): Remove function. + * decl.c (gfc_match_kind_spec): Add C kind parameter check. + (verify_bind_c_derived_type): Remove gfc_validate_c_kind call. + (verify_c_interop_param): Update call. + * gfortran.h (verify_bind_c_derived_type): Update prototype. + (gfc_validate_c_kind): Remove. + * symbol.c (verify_bind_c_derived_type): Update verify_c_interop call. + * resolve.c (gfc_iso_c_func_interface): Ditto. + + 2008-11-22 Jakub Jelinek + + PR libfortran/37839 + * trans-io.c (gfc_build_io_library_fndecls): Decrease pad size back + to 16 pointers plus 32 integers. Don't use max integer kind + alignment, only gfc_intio_kind's alignment. + (gfc_trans_inquire): Only set flags2 if mask2 is non-zero. + * ioparm.def: Fix order, bitmasks and types of inquire round, sign + and pending fields. Move u in dt before id. + * io.c (gfc_free_inquire): Free decimal and size exprs. + (match_inquire_element): Match size instead of matching blank twice. + (gfc_resolve_inquire): Resolve size. + + 2008-11-20 Jakub Jelinek + + PR middle-end/29215 + * trans-array.c (trans_array_constructor_value, + gfc_build_constant_array_constructor): Fill in TREE_PURPOSE. + + * trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Use + gfc_index_one_node. + (gfc_conv_intrinsic_size): Use gfc_index_{zero,one}_node. + + PR fortran/38181 + * trans-intrinsic.c (gfc_conv_intrinsic_size): Inline 2 argument + size if the second argument is not optional and one argument size + for rank 1 arrays. + + 2008-11-19 Paul Thomas + + PR fortran/38171 + * module.c (load_equiv): Regression fix; check that equivalence + members come from the same module only. + + 2008-11-16 Mikael Morin + + PR fortran/35681 + * dependency.c (gfc_check_argument_var_dependency): Add + elemental check flag. Issue a warning if we find a dependency + but don't generate a temporary. Add the case of an elemental + function call as actual argument to an elemental procedure. + Add the case of an operator expression as actual argument + to an elemental procedure. + (gfc_check_argument_dependency): Add elemental check flag. + Update calls to gfc_check_argument_var_dependency. + (gfc_check_fncall_dependency): Add elemental check flag. + Update call to gfc_check_argument_dependency. + * trans-stmt.c (gfc_trans_call): Make call to + gfc_conv_elemental_dependencies unconditional, but with a flag + whether we should check dependencies between variables. + (gfc_conv_elemental_dependencies): Add elemental check flag. + Update call to gfc_check_fncall_dependency. + * trans-expr.c (gfc_trans_arrayfunc_assign): Update call to + gfc_check_fncall_dependency. + * resolve.c (find_noncopying_intrinsics): Update call to + gfc_check_fncall_dependency. + * dependency.h (enum gfc_dep_check): New enum. + (gfc_check_fncall_dependency): Update prototype. + + 2008-11-16 Mikael Morin + + PR fortran/37992 + * gfortran.h (gfc_namespace): Added member old_cl_list, + backup of cl_list. + (gfc_free_charlen): Added prototype. + * symbol.c (gfc_free_charlen): New function. + (gfc_free_namespace): Use gfc_free_charlen. + * parse.c (next_statement): Backup gfc_current_ns->cl_list. + (reject_statement): Restore gfc_current_ns->cl_list. + Free cl_list's elements before dropping them. + + 2008-11-16 Tobias Burnus + + PR fortran/38095 + * trans-expr.c (gfc_map_intrinsic_function): Fix pointer access. + + 2008-11-16 Paul Thomas + + PR fortran/38119 + * trans-array.c (gfc_trans_create_temp_array): Set the + loop->from to zero and the renormalisation of loop->to for all + dimensions. + + 2008-11-16 Paul Thomas + + PR fortran/37926 + * trans-expr.c (gfc_free_interface_mapping): Null sym->formal + (gfc_add_interface_mapping): Copy the pointer to the formal + arglist, rather than using copy_formal_args - fixes regression. + + 2008-11-15 Paul Thomas + + PR fortran/37926 + * trans-expr.c (gfc_add_interface_mapping): Transfer the formal + arglist and the always_explicit attribute if the dummy arg is a + procedure. + + 2008-11-14 Jerry DeLisle + + PR fortran/37988 + * io.c (enum format_token): For readability replace FMT_POS with FMT_T, + FMT_TL, and FMT_TR. (format_lex): Use new enumerators. (check_format): + Add check for missing positive integer. + + 2008-10-14 Paul Thomas + + PR fortran/38033 + * trans-array.c (gfc_trans_create_temp_array): Stabilize the + 'to' expression. + (gfc_conv_loop_setup): Use the end expression for the loop 'to' + if it is available. + + 2008-11-12 Jakub Jelinek + + PR target/35366 + PR fortran/33759 + * trans-const.c (gfc_conv_constant_to_tree): Warn when + converting an integer outside of LOGICAL's range to + LOGICAL. + * trans-intrinsic.c (gfc_conv_intrinsic_function, + gfc_conv_intrinsic_array_transfer, gfc_conv_intrinsic_transfer): + Use INTEGER_TYPE instead of BOOLEAN_TYPE for TRANSFER as + argument of another TRANSFER. + + 2008-11-12 Tobias Burnus + + PR fortran/38065 + * resolve.c (resolve_fntype): Fix private derived type checking. + + 2008-11-09 Paul Thomas + + PR fortran/37836 + * intrinsic.c (add_functions): Reference gfc_simplify._minval + and gfc_simplify_maxval. + * intrinsic.h : Add prototypes for gfc_simplify._minval and + gfc_simplify_maxval. + * simplify.c (min_max_choose): New function extracted from + simplify_min_max. + (simplify_min_max): Call it. + (simplify_minval_maxval, gfc_simplify_minval, + gfc_simplify_maxval): New functions. + + 2008-11-04 Paul Thomas + + PR fortran/37597 + * parse.c (gfc_fixup_sibling_symbols ): Fixup contained, even + when symbol not found. + + 2008-11-03 Tobias Burnus + + PR fortran/37821 + * cpp.c (gfc_cpp_add_include_path): Use BRACKET. + * scanner.c (add_path_to_list): Argument to add at head. + (gfc_add_include_path): Add new argument. + (gfc_add_intrinsic_modules_path) Update call. + (load_file): Print filename/line in the error message. + * gfortran.h (gfc_add_include_path): Update prototype. + * options.c (gfc_post_options,gfc_handle_module_path_options, + gfc_handle_option): Update call. + * lang-spec.h (F951_OPTIONS): Don't insert include path twice. + + * arith.c (arith_error): Add -fno-range-error to the message. + + 2008-11-03 Paul Thomas + + PR fortran/37445 + * resolve.c (resolve_actual_arglist ): Correct comparison of + FL_VARIABLE with e->expr_type. + (resolve_call): Check that host association is correct. + (resolve_actual_arglist ): Remove return is old_sym is use + associated. Only reparse expression if old and new symbols + have different types. + + PR fortran/PR35769 + * resolve.c (gfc_resolve_assign_in_forall): Change error to a + warning. + + 2008-11-01 Janus Weil + + PR fortran/36426 + * expr.c (replace_symbol): Replace all symbols which lie in the + formal namespace of the interface and copy their attributes. + * resolve.c (resolve_symbol): Add charlen to namespace. + + 2008-11-01 Steven G. Kargl + + PR fortran/19925 + * trans-array.c (gfc_trans_array_constructor_value): Fix comment. + (gfc_conv_array_initializer): Convert internal_error() to gfc_error_now. + * array.c: Remove GFC_MAX_AC_EXPAND macro. + (gfc_expand_constructor): Use gfc_option.flag_max_array_constructor. + * gfortran.h (gfc_option): Add flag_max_array_constructor member. + * lang.opt: Add -fmax-array-constructor option. + * expr.c (gfc_match_init_expr): Fix error message to mention new option. + * invoke.texi: Document new option. + * options.c (gfc_init_options): Set default value for new option. + (gfc_handle_option): Deal with commandline. + + 2008-11-01 Daniel Kraft + + PR fortran/35681 + * gfortran.h (struct gfc_code): New field `resolved_isym'. + * trans.h (gfc_build_memcpy_call): Made public. + * trans-array.h (gfc_trans_create_temp_array): New argument `initial'. + * intrinsic.c (gfc_intrinsic_sub_interface): Set resolved_isym. + * iresolve.c (create_formal_for_intents): New helper method. + (gfc_resolve_mvbits): Put dummy formal arglist on resolved_sym. + * resolve.c (resolve_call): Initialize resolved_isym to NULL. + * trans-array.c (gfc_trans_allocate_array_storage): New argument + `initial' to allow initializing the allocated storage to some initial + value copied from another array. + (gfc_trans_create_temp_array): Allow initialization of the temporary + with a copy of some other array by using the new extension. + (gfc_trans_array_constructor): Pass NULL_TREE for initial argument. + (gfc_conv_loop_setup): Ditto. + * trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): Ditto. + * trans-expr.c (gfc_conv_function_call): Ditto. + (gfc_build_memcpy_call): Made public. + * trans-stmt.c (gfc_conv_elemental_dependencies): Initialize created + temporary for INTENT(INOUT) arguments to the value of the mirrored + array and clean up the temporary as very last intructions in the created + block. + * trans.c (gfc_trans_code): For EXEC_CALL, see if we have a MVBITS call + and enable elemental dependency checking if we have. + + 2008-11-01 Janus Weil + + PR fortran/36322 + PR fortran/36463 + * gfortran.h: New function gfc_expr_replace_symbols. + * decl.c (match_procedure_decl): Increase reference count for interface. + * expr.c: New functions replace_symbol and gfc_expr_replace_symbols. + * resolve.c (resolve_symbol): Correctly copy array spec and char len + of PROCEDURE declarations from their interface. + * symbol.c (gfc_get_default_type): Enhanced error message. + (copy_formal_args): Call copy_formal_args recursively for arguments. + * trans-expr.c (gfc_conv_function_call): Bugfix. + + 2008-11-01 Dennis Wassel + + PR fortran/37159 + * fortran/check.c (gfc_check_random_seed): Check PUT size + at compile time. + + 2008-10-31 Mikael Morin + + PR fortran/35840 + * expr.c (gfc_reduce_init_expr): New function, containing checking code + from gfc_match_init_expr, so that checking can be deferred. + (gfc_match_init_expr): Use gfc_reduce_init_expr. + * io.c (check_io_constraints): Use gfc_reduce_init_expr instead of + checking that the expression is a constant. + * match.h (gfc_reduce_init_expr): Prototype added. + + 2008-10-31 Mikael Morin + + PR fortran/35820 + * resolve.c (gfc_count_forall_iterators): New function. + (gfc_resolve_forall): Use gfc_count_forall_iterators to evaluate + the needed memory amount to allocate. Don't forget to free allocated + memory. Add an assertion to check for memory leaks. + + 2008-10-30 Steven G. Kargl + + PR fortran/37930 + * fortran/arith.c (gfc_mpfr_to_mpz): Test for NaN and Inf values. + Remove stale comment and kludge code for MPFR 2.0.1 and older. + (gfc_real2int): Error on conversion of NaN or Inf. + (gfc_complex2int): Ditto. + * fortran/arith.h: Update mpfr_to_mpz prototype. + * fortran/simplify.c (gfc_simplify_ceiling, gfc_simplify_floor, + gfc_simplify_ifix, gfc_simplify_idint, simplify_nint): Update function + calls to include locus. + + 2008-10-30 Mikael Morin + + PR fortran/37903 + * trans-array.c (gfc_trans_create_temp_array): If n is less + than the temporary dimension, assert that loop->from is + zero (reverts to earlier versions). If there is at least one + null loop->to[n], it is a callee allocated array so set the + size to NULL and break. + (gfc_trans_constant_array_constructor): Set the offset to zero. + (gfc_trans_array_constructor): Remove loop shifting around the + temporary creation. + (gfc_conv_loop_setup): Prefer zero-based descriptors if + possible. Calculate the translation from loop variables to + array indices if an array constructor. + + 2008-10-30 Mikael Morin + + PR fortran/37749 + * trans-array.c (gfc_trans_create_temp_array): If size is NULL + use the array bounds for loop->to. + + 2008-10-28 Tobias Burnus + + * intrinsic.texi: Update OpenMP section for OMPv3. + + 2008-10-24 Jakub Jelinek + + * Make-lang.in (check-f95-subtargets, check-fortran-subtargets): New + aliases for check-gfortran-subtargets. + (lang_checks_parallelized): Add check-gfortran. + (check_gfortran_parallelize): New variable. + + 2008-10-19 Paul Thomas + + PR fortran/37723 + * dependency.c (gfc_dep_resolver ): If we find equal array + element references, go on to the next reference. + + 2008-10-16 Daniel Kraft + + * resolve.c (resolve_elemental_actual): Handle calls to intrinsic + subroutines correctly. + + 2008-10-13 Kaveh R. Ghazi + + * simplify.c: Remove MPFR_VERSION_NUM(2,3,0) conditionals. + + 2008-10-12 Daniel Kraft + + PR fortran/37688 + * expr.c (gfc_expr_check_typed): Extend permission of untyped + expressions to both top-level variable and basic arithmetic expressions. + + 2008-10-12 Paul Thomas + + PR fortran/37787 + * dependency.c (gfc_are_equivalenced_arrays): Look in symbol + namespace rather than current namespace, if it is available. + + 2008-10-12 Steven G. Kargl + + PR fortran/37792 + * fortran/resolve.c (resolve_fl_variable): Simplify the + initializer if there is one. + + 2008-10-11 Paul Thomas + + PR fortran/37794 + * module.c (check_for_ambiguous): Remove redundant code. + + 2008-10-09 Daniel Kraft + + PR fortran/35723 + * gfortran.h (gfc_suppress_error): Removed from header. + (gfc_push_suppress_errors), (gfc_pop_suppress_errors): New methods. + * array.c (gfc_array_size): Use new gfc_push/pop_suppress_errors + instead of directly changing gfc_suppress_error. + * intrinsic.c (gfc_intrinsic_func_interface): Ditto. + (gfc_intrinsic_sub_interface): Ditto. + * error.c (suppress_errors): Made static from `gfc_suppress_error'. + (gfc_push_suppress_errors), (gfc_pop_suppress_errors): New methods. + (gfc_notify_std), (gfc_error): Use new static name of global. + * expr.c (check_arglist), (check_references): New methods. + (check_restricted): Check arglists and references of EXPR_FUNCTIONs + and EXPR_VARAIBALEs, respectively. Allow PARAMETER symbols. + + 2008-10-07 Jakub Jelinek + + * f95-lang.c (poplevel): Don't clear BLOCK_VARS if functionbody. + * trans-decl.c (gfc_build_qualified_array): Build accurate debug type + even if nest. + (build_entry_thunks, gfc_generate_function_code, + gfc_generate_constructors): Ensure DECL_SAVED_TREE is a BIND_EXPR + with DECL_INITIAL as its BLOCK. + + 2008-10-05 Paul Thomas + + PR fortran/35680 + * gfortran.h : Add 'error' bit field to gfc_expr structure. + * expr.c (check_inquiry): When checking a restricted expression + check that arguments are either variables or restricted. + (check_restricted): Do not emit error if the expression has + 'error' set. Clean up detection of host-associated variable. + + 2008-10-05 Daniel Kraft + + PR fortran/37638 + * gfortran.h (struct gfc_typebound_proc): New flag `error'. + * resolve.c (update_arglist_pass): Added assertion. + (update_compcall_arglist): Fail early for erraneous procedures to avoid + confusion later. + (resolve_typebound_generic_call): Ignore erraneous specific targets + and added assertions. + (resolve_typebound_procedure): Set new `error' flag. + + 2008-10-04 Paul Thomas + + PR fortran/37706 + * module.c (load_equiv): Check the module before negating the + unused flag. + + 2008-10-02 Steven Bosscher + + PR fortran/37635 + * intrinsic.c (add_functions): Add LEADZ and TRAILZ as generics. + * intrinsic.h (gfc_simplify_leadz, gfc_simplify_trailz): New protos. + * gfortran.h : (GFC_ISYM_LEADZ, GFC_ISYM_TRAILZ): New. + * f95-lang (gfc_init_builtin_functions): Add BUILT_IN_CLZ, + BUILT_IN_CLZL, BUILT_IN_CLZLL, BUILT_IN_CTZ, BUILT_IN_CTZL, and + BUILT_IN_CTZLL. + * trans-intrinsic.c (gfc_conv_intrinsic_leadz, + gfc_conv_intrinsic_trails): New code-generation functions for LEADZ + and TRAILZ intrinsics. + (gfc_conv_intrinsic_function): Use them + * intrinsic.texi: Add documentation for LEADZ and TRAILZ. + * simplify.c (gfc_simplify_leadz, gfc_simplify_trailz): New functions. + + 2008-09-30 Janus Weil + + PR fortran/36592 + * symbol.c (check_conflict): If a symbol in a COMMON block is a + procedure, it must be a procedure pointer. + (gfc_add_in_common): Symbols in COMMON blocks may be variables or + procedure pointers. + * trans-types.c (gfc_sym_type): Make procedure pointers in COMMON + blocks work. + + 2008-09-25 Jerry DeLisle + + PR fortran/37504 + * expr.c (gfc_check_pointer_assign): Allow assignment of + protected pointers. + * match.c (gfc_match_assignment,gfc_match_pointer_assignment): + Remove unreachable code. + + 2008-09-24 Tobias Burnus + + * options.c (set_default_std_flags,gfc_init_options): + Add comment: keep in sync with libgfortran. + + 2008-09-24 Tobias Burnus + + PR fortran/37626 + * trans-array.c (gfc_trans_deferred_array): Don't auto-deallocate + result variables. + + 2008-09-23 Daniel Kraft + + PR fortran/37588 + * gfortran.h (gfc_compare_actual_formal): Removed, made private. + (gfc_arglist_matches_symbol): New method. + * interface.c (compare_actual_formal): Made static. + (gfc_procedure_use): Use new name of compare_actual_formal. + (gfc_arglist_matches_symbol): New method. + (gfc_search_interface): Moved code partially to new + gfc_arglist_matches_symbol. + * resolve.c (resolve_typebound_generic_call): Resolve actual arglist + before checking against formal and use new gfc_arglist_matches_symbol + for checking. + (resolve_compcall): Set type-spec of generated expression. + + 2008-09-23 Tobias Burnus + + PR fortran/37580 + * expr.c (gfc_check_pointer_assign): Add checks for pointer + remapping. + + 2008-09-22 Jerry DeLisle + + PR fortran/37486 + * gfortran.h (gfc_option_t): New members flag_align_commons and + warn_align_commons. + * lang.opt: New options falign-commons and Walign-commons. + * invoke.texi: Documentation for new options. + * options.c (gfc_init_options): Initialize new options. + (gfc_handle_options): Handle new options. + * trans-common.c (translate_common): Implement new options. + (gfc_trans_common): Set correct locus. + + 2008-09-21 Paul Thomas + + PR fortran/37583 + * decl.c (scalarize_intrinsic_call): Both subroutines and + functions can give a true for get_proc_mame's last argument so + remove the &&gfc_current_ns->proc_name->attr.function. + resolve.c (resolve_actual_arglist): Add check for recursion by + reference to procedure as actual argument. + + 2008-09-21 Daniel Kraft + + PR fortran/35846 + * trans.h (gfc_conv_string_length): New argument `expr'. + * trans-expr.c (flatten_array_ctors_without_strlen): New method. + (gfc_conv_string_length): New argument `expr' that is used in a new + special case handling if cl->length is NULL. + (gfc_conv_subref_array_arg): Pass expr to gfc_conv_string_length. + * trans-array.c (gfc_conv_expr_descriptor): Ditto. + (gfc_trans_auto_array_allocation): Pass NULL as new expr. + (gfc_trans_g77_array), (gfc_trans_dummy_array_bias): Ditto. + (gfc_trans_deferred_array): Ditto. + (gfc_trans_array_constructor): Save and restore old values of globals + used for bounds checking. + * trans-decl.c (gfc_trans_dummy_character): Ditto. + (gfc_trans_auto_character_variable): Ditto. + + 2008-09-21 Daniel Kraft + + * decl.c (match_procedure_in_type): Changed misleading error message + for not yet implemented PROCEDURE(interface) syntax. + + 2008-09-18 Paul Thomas + + PR fortran/35945 + * resolve.c (resolve_fl_variable_derived): Remove derived type + comparison for use associated derived types. Host association + of a derived type will not arise if there is a local derived type + whose use name is the same. + + PR fortran/36700 + * match.c (gfc_match_call): Use the existing symbol even if + it is a function. + + 2008-09-18 Daniel Kraft + + PR fortran/37507 + * trans.h (gfc_trans_runtime_error): New method. + (gfc_trans_runtime_error_vararg): New method. + (gfc_allocate_array_with_status): New argument `expr' for locus/varname. + (gfc_deallocate_array_with_status): Ditto. + * trans-array.h (gfc_array_deallocate): Ditto. + * trans.c (gfc_trans_runtime_error): New method. + (gfc_trans_runtime_error_vararg): New method, moved parts of the code + from gfc_trans_runtime_check here. + (gfc_trans_runtime_error_check): Moved code partly to new method. + (gfc_call_malloc): Fix tab-indentation. + (gfc_allocate_array_with_status): New argument `expr' and call + gfc_trans_runtime_error for error reporting to include locus. + (gfc_deallocate_with_status): Ditto. + * trans-stmt.c (gfc_trans_deallocate): Pass expr as new argument. + * trans-array.c (gfc_array_allocate): Ditto. + (gfc_array_deallocate): New argument `expr', passed on. + (gfc_trans_dealloc_allocated): Pass NULL for expr. + * trans-openmp.c (gfc_omp_clause_default): Ditto. + + 2008-09-18 Paul Thomas + + PR fortran/37274 + PR fortran/36374 + * module.c (check_for_ambiguous): New function to test loaded + symbol for ambiguity with fixup symbol. + (read_module): Call check_for_ambiguous. + (write_symtree): Do not write the symtree for symbols coming + from an interface body. + + PR fortran/36374 + * resolve.c (count_specific_procs ): New function to count the + number of specific procedures with the same name as the generic + and emit appropriate errors for and actual argument reference. + (resolve_assumed_size_actual): Add new argument no_formal_args. + Correct logic around passing generic procedures as arguments. + Call count_specific_procs from two locations. + (resolve_function): Evaluate and pass no_formal_args. + (resolve call): The same and clean up a bit by using csym more + widely. + + PR fortran/36454 + * symbol.c (gfc_add_access): Access can be updated if use + associated and not private. + + 2008-09-17 Jakub Jelinek + + PR fortran/37536 + * trans-stmt.c (gfc_trans_do): Optimize integer type non-simple + do loop initialization. + + 2008-09-14 Jerry DeLisle + Tobias Burnus + + PR fortran/35840 + * io.c (match_vtag): Add tag name to error message. + (match_out_tag): Cleanup whitespace. + (gfc_resolve_dt): Resolve id and async tags. + + 2008-09-13 Daniel Kraft + + PR fortran/35770 + * primary.c (gfc_match_varspec): Added missing type-spec clearing + after wrong implicit character typing. + + 2008-09-12 Richard Guenther + + * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Use + build_fold_addr_expr to properly mark the argument + addressable. + + 2008-09-11 Daniel Kraft + + PR fortran/36214 + * simplify.c (simplify_cmplx): Added linebreak to long line. + * target-memory.c (gfc_convert_boz): Fix indentation. + (gfc_interpret_float): Set mpfr precision to right value before + calling mpfr_init. + + 2008-09-10 H.J. Lu + + * expr.c (find_array_element): Reformat comment. + + 2008-09-10 H.J. Lu + + * expr.c (find_array_element): Reformat. + + 2008-09-10 Tobias Burnus + + PR fortran/37420 + * trans-decl.c (get_proc_pointer_decl): Fix -Wunused-variable. + + 2008-09-09 Daniel Kraft + + PR fortran/37429 + * resolve.c (expression_rank): Added assertion to guard against + EXPR_COMPCALL expressions. + (resolve_compcall): Set expression's rank from the target procedure's. + + 2008-09-09 Daniel Kraft + + PR fortran/37411 + * trans-array.c (gfc_conv_array_parameter): Added assertion that the + symbol has an array spec. + + 2008-09-08 Daniel Kraft + + PR fortran/37199 + * trans-expr.c (gfc_add_interface_mapping): Set new_sym->as. + (gfc_map_intrinsic_function): Added checks against NULL bounds in + array specs. + + 2008-09-08 Tobias Burnus + + PR fortran/37400 + * symbol.c (gfc_set_default_type): Copy char len. + + 2008-09-06 Steven G. Kargl + + PR fortran/36153 + * fortran/resolve.c (resolve_function): Shortcircuit for SIZE and + UBOUND if 2nd argument is KIND. + + 2008-09-06 Steven G. Kargl + + PR fortran/33229 + * resolve.c (resolve_function): An intrinsic subroutine should not be + called as a function. + + 2008-09-05 Daniel Kraft + + PR fortran/35837 + * resolve.c (resolve_types): Restore gfc_current_ns on exit. + * symbol.c (gfc_save_all): Removed blank line. + + 2008-09-05 Daniel Kraft + + PR fortran/36746 + * primary.c (gfc_match_rvalue): Removed logic to handle implicit + typing to a derived-type if a component reference is found. + (gfc_match_varspec): Moved it here. + + 2008-09-04 Richard Guenther + + * trans-array.c (gfc_conv_array_parameter): Use correct types + in building COND_EXPRs. + * trans-expr.c (gfc_conv_missing_dummy): Likewise. + * trans-intrinsics.c (gfc_conv_intrinsic_merge): Likewise. + + 2008-09-04 Daniel Kraft + + * PR fortran/37099 + * expr.c (simplify_const_ref): Update expression's character length + when pulling out a substring reference. + + 2008-09-04 Ian Lance Taylor + + * symbol.c (generate_isocbinding_symbol): Compare + gfc_notification_std with ERROR rather than FAILURE. + * resolve.c (check_assumed_size_reference): Compare array type + with AR_FULL rather than DIMEN_ELEMENT. + (resolve_actual_arglist): Compare with EXPR_VARIABLE rather than + FL_VARIABLE. + + 2008-09-01 Jerry DeLisle + + PR fortran/37228 + * io.c (check_format): Allow specifying precision with g0 format. + + 2008-09-02 Daniel Kraft + + * gfortran.h (struct gfc_namespace): New member `implicit_loc'. + (gfc_add_abstract): New method. + * decl.c (gfc_get_type_attr_spec): Match ABSTRACT attribute. + (gfc_match_derived_decl): Copy abstract attribute in derived symbol. + * dump-parse-tree.c (show_attr): Show ABSTRACT attribute as `ABSTRACT' + only to allow for ABSTRACT types. + * parse.c (parse_interface): Use new gfc_add_abstract. + * primary.c (gfc_match_structure_constructor): Check that no ABSTRACT + type is constructed. + * resolve.c (resolve_typespec_used): New method. + (resolve_fl_derived): Check type in respect to ABSTRACT attribute and + check that no component is of an ABSTRACT type. + (resolve_symbol): Check that no symbol is of an ABSTRACT type. + (resolve_types): Check IMPLICIT declarations for ABSTRACT types. + * symbol.c (gfc_merge_new_implicit): Remember loci of IMPLICIT's. + (gfc_add_abstract): New method. + + 2008-09-01 Daniel Kraft + + PR fortran/37193 + * module.c (read_module): Initialize use_only flag on used symbols. + + 2008-09-01 Daniel Kraft + + * gfc-internals.texi (F2003 OOP), (Type-bound Procedures): New chapter + and section to document the internals of type-bound procedures. + (gfc_expr): Document EXPR_COMPCALL. + * gfortran.h (struct gfc_expr): Remove unused `derived' from compcall. + * dump-parse-tree.c (show_compcall): New method. + (show_expr): Call it for EXPR_COMPCALL. + (show_typebound), (show_f2k_derived): New methods. + (show_symbol): Call show_f2k_derived. + (show_code_node): Handle EXEC_COMPCALL. + * primary.c (gfc_match_varspec): Don't initialize removed `derived' in + primary->value.compcall. + + 2008-08-31 Richard Guenther + + * trans-expr.c (gfc_trans_string_copy): Use the correct types + to compute slen and dlen. + + 2008-08-31 Daniel Kraft + + * gfortran.h (enum gfc_statement): New entry `ST_GENERIC'. + (struct gfc_tbp_generic): New type. + (struct gfc_typebound_proc): Removed `target' and added union with + `specific' and `generic' members; new members `overridden', + `subroutine', `function' and `is_generic'. + (struct gfc_expr): New members `derived' and `name' in compcall union + member and changed type of `tbp' to gfc_typebound_proc. + (gfc_compare_interfaces), (gfc_compare_actual_formal): Made public. + * match.h (gfc_typebound_default_access): New global. + (gfc_match_generic): New method. + * decl.c (gfc_match_generic): New method. + (match_binding_attributes): New argument `generic' and handle it. + (match_procedure_in_type): Mark matched binding as non-generic. + * interface.c (gfc_compare_interfaces): Made public. + (gfc_compare_actual_formal): Ditto. + (check_interface_1), (compare_parameter): Use new public names. + (gfc_procedure_use), (gfc_search_interface): Ditto. + * match.c (match_typebound_call): Set base-symbol referenced. + * module.c (binding_generic): New global array. + (current_f2k_derived): New global. + (mio_typebound_proc): Handle IO of GENERIC bindings. + (mio_f2k_derived): Record current f2k-namespace in current_f2k_derived. + * parse.c (decode_statement): Handle GENERIC statement. + (gfc_ascii_statement): Ditto. + (typebound_default_access), (set_typebound_default_access): Removed. + (gfc_typebound_default_access): New global. + (parse_derived_contains): New default-access implementation and handle + GENERIC statements encountered. + * primary.c (gfc_match_varspec): Adapted to new gfc_typebound_proc + structure and removed check for SUBROUTINE/FUNCTION from here. + * resolve.c (extract_compcall_passed_object): New method. + (update_compcall_arglist): Use it. + (resolve_typebound_static): Adapted to new gfc_typebound_proc structure. + (resolve_typebound_generic_call): New method. + (resolve_typebound_call): Check target is a SUBROUTINE and handle calls + to GENERIC bindings. + (resolve_compcall): Ditto (check for target being FUNCTION). + (check_typebound_override): Handle GENERIC bindings. + (check_generic_tbp_ambiguity), (resolve_typebound_generic): New methods. + (resolve_typebound_procedure): Handle GENERIC bindings and set new + attributes subroutine, function and overridden in gfc_typebound_proc. + (resolve_fl_derived): Ensure extended type is resolved before the + extending one is. + * st.c (gfc_free_statement): Fix bug with free'ing EXEC_COMPCALL's. + * symbol.c (gfc_find_typebound_proc): Adapt for GENERIC changes. + + 2008-08-29 Jan Hubicka + + * parse.c (parse_interface): Silence uninitialized var warning. + + 2008-08-29 Jakub Jelinek + + * trans.h (struct lang_type): Add span. + (GFC_TYPE_ARRAY_SPAN): Define. + * trans-decl.c (gfc_get_symbol_decl): For subref array pointers, + copy TREE_STATIC from decl to span instead of setting it + unconditionally, set DECL_ARTIFICIAL, fix type of initializer + and set GFC_TYPE_ARRAY_SPAN on decl's type. + * trans-types.c (gfc_get_array_descr_info): If + GFC_TYPE_ARRAY_SPAN is non-NULL, use it as element size. + + * trans-decl.c (check_constant_initializer, + gfc_emit_parameter_debug_info): New functions. + (gfc_generate_module_vars, gfc_generate_function_code): Emit + PARAMETERs and unreferenced variables with initializers into + debug info. + + * gfortran.h (gfc_use_list): Add where field. + * module.c (use_locus): New static variable. + (gfc_match_use): Set it. + (gfc_use_module): Copy it to gfc_use_list's where field. + * trans-decl.c (gfc_generate_module_vars): Call gfc_trans_use_stmts. + (gfc_trans_use_stmts): Set backend locus before calling the debug + hook. Allow non-VAR_DECLs to be created even for non-external + module. Don't emit anything so far for renames from different + modules. + + PR fortran/24790 + * trans-decl.c (create_function_arglist): Set DECL_BY_REFERENCE on + PARM_DECLs with pointer or reference type. + + * trans-decl.c (gfc_build_qualified_array): Build non-flat + array type for debug info purposes. + + PR fortran/29635 + PR fortran/23057 + * f95-lang.c (gfc_init_ts): New function. + (LANG_HOOKS_INIT_TS): Define. + * gfortran.h (gfc_use_rename): New type, moved from module.c. + (gfc_get_use_rename): New macro, moved from module.c. + (gfc_use_list): New type. + (gfc_get_use_list): New macro. + (gfc_namespace): Add use_stmts field. + (gfc_free_use_stmts): New prototype. + * Make-lang.in (fortran/trans-decl.o): Depend on debug.h. + * module.c (gfc_use_rename, gfc_get_use_rename): Moved to + gfortran.h. + (gfc_use_module): Chain the USE statement info to + ns->use_stmts. + (gfc_free_use_stmts): New function. + * symbol.c (gfc_free_namespace): Call gfc_free_use_stmts. + * trans.h (struct module_htab_entry): New type. + (gfc_find_module, gfc_module_add_decl): New functions. + * trans.c (gfc_generate_module_code): Create NAMESPACE_DECL for + the module, adjust DECL_CONTEXTs of module procedures and + call gfc_module_add_decl for them. + * trans-common.c (build_common_decl): Set DECL_IGNORED_P + on the common variable. + (create_common): Set DECL_IGNORED_P for use associated vars. + * trans-decl.c: Include debug.h. + (gfc_get_symbol_decl): Set DECL_IGNORED_P on use_assoc vars from + modules. + (build_function_decl): Allow current_function_decl's context + to be a NAMESPACE_DECL. + (module_htab, cur_module): New variables. + (module_htab_do_hash, module_htab_eq, module_htab_decls_hash, + module_htab_decls_eq, gfc_find_module, gfc_module_add_decl): New + functions. + (gfc_create_module_variable): Adjust DECL_CONTEXTs of module + variables and types and call gfc_module_add_decl for them. + (gfc_generate_module_vars): Temporarily set cur_module. + (gfc_trans_use_stmts): New function. + (gfc_generate_function_code): Call it. + (gfc_generate_block_data): Set DECL_IGNORED_P on decl. + * trans-types.c (gfc_get_derived_type): Adjust DECL_CONTEXT + and TYPE_CONTEXT of module derived types. + + 2008-08-28 Daniel Kraft + + * gfortran.h (enum expr_t): New value `EXPR_COMPCALL'. + (gfc_get_typebound_proc): New macro. + (struct gfc_expr): New union-member `compcall' for EXPR_COMPCALL. + (enum gfc_exec_op): New value `EXEC_COMPCALL'. + (gfc_find_typebound_proc): New argument. + (gfc_copy_ref), (gfc_match_varspec): Made public. + * decl.c (match_procedure_in_type): Use gfc_get_typebound_proc. + * expr.c (free_expr0), (gfc_copy_expr): Handle EXPR_COMPCALL. + (gfc_copy_ref): Made public and use new name. + (simplify_const_ref): Use new name of gfc_copy_ref. + (simplify_parameter_variable): Ditto. + (gfc_simplify_expr): gcc_unreachable for EXPR_COMPCALL. + * match.c (match_typebound_call): New method. + (gfc_match_call): Allow for CALL's to typebound procedures. + * module.c (binding_passing), (binding_overriding): New variables. + (expr_types): Add EXPR_COMPCALL. + (mio_expr): gcc_unreachable for EXPR_COMPCALL. + (mio_typebound_proc), (mio_typebound_symtree): New methods. + (mio_f2k_derived): Handle type-bound procedures. + * primary.c (gfc_match_varspec): Made public and parse trailing + references to type-bound procedures; new argument `sub_flag'. + (gfc_match_rvalue): New name and argument of gfc_match_varspec. + (match_variable): Ditto. + * resolve.c (update_arglist_pass): New method. + (update_compcall_arglist), (resolve_typebound_static): New methods. + (resolve_typebound_call), (resolve_compcall): New methods. + (gfc_resolve_expr): Handle EXPR_COMPCALL. + (resolve_code): Handle EXEC_COMPCALL. + (resolve_fl_derived): New argument to gfc_find_typebound_proc. + (resolve_typebound_procedure): Ditto and removed not-implemented error. + * st.c (gfc_free_statement): Handle EXEC_COMPCALL. + * symbol.c (gfc_find_typebound_proc): New argument `noaccess' and + implement access-checking. + * trans-expr.c (gfc_apply_interface_mapping_to_expr): gcc_unreachable + on EXPR_COMPCALL. + * trans-intrinsic.c (gfc_conv_intrinsic_bound): Add missing break. + * trans-openmp.c (gfc_trans_omp_array_reduction): Add missing + intialization of ref->type. + + 2008-08-28 Janus Weil + + PR fortran/37253 + * module.c (ab_attribute,attr_bits,mio_symbol_attribute): Take care of + saving attr.procedure and attr.proc_ptr to the module file. + + 2008-08-25 Daniel Kraft + + * gfortran.h (gfc_find_component): Add new arguments. + * parse.c (parse_derived_contains): Check if the derived-type containing + the CONTAINS section is SEQUENCE/BIND(C). + * resolve.c (resolve_typebound_procedure): Check for name collision with + components. + (resolve_fl_derived): Check for name collision with inherited + type-bound procedures. + * symbol.c (gfc_find_component): New arguments `noaccess' and `silent'. + (gfc_add_component): Adapt for new arguments. + * primary.c (match_varspec), (gfc_match_structure_constructor): Ditto. + + 2008-08-24 Tobias Burnus + + PR fortran/37201 + * decl.c (verify_bind_c_sym): Reject array/string returning + functions. + + 2008-08-24 Tobias Burnus + + PR fortran/37201 + * trans-expr.c (gfc_conv_function_call): Add string_length + for character-returning bind(C) functions. + + 2008-08-24 Daniel Kraft + + * gfortran.h (gfc_typebound_proc): New struct. + (gfc_symtree): New member typebound. + (gfc_find_typebound_proc): Prototype for new method. + (gfc_get_derived_super_type): Prototype for new method. + * parse.h (gfc_compile_state): New state COMP_DERIVED_CONTAINS. + * decl.c (gfc_match_procedure): Handle PROCEDURE inside derived-type + CONTAINS section. + (gfc_match_end): Handle new context COMP_DERIVED_CONTAINS. + (gfc_match_private): Ditto. + (match_binding_attributes), (match_procedure_in_type): New methods. + (gfc_match_final_decl): Rewrote to make use of new + COMP_DERIVED_CONTAINS parser state. + * parse.c (typebound_default_access): New global helper variable. + (set_typebound_default_access): New callback method. + (parse_derived_contains): New method. + (parse_derived): Extracted handling of CONTAINS to new parser state + and parse_derived_contains. + * resolve.c (resolve_bindings_derived), (resolve_bindings_result): New. + (check_typebound_override), (resolve_typebound_procedure): New methods. + (resolve_typebound_procedures): New method. + (resolve_fl_derived): Call new resolving method for typebound procs. + * symbol.c (gfc_new_symtree): Initialize new member typebound to NULL. + (gfc_find_typebound_proc): New method. + (gfc_get_derived_super_type): New method. + + 2008-08-23 Janus Weil + + * gfortran.h (gfc_component): Add field "symbol_attribute attr", remove + fields "pointer", "allocatable", "dimension", "access". + Remove functions "gfc_set_component_attr" and "gfc_get_component_attr". + * interface.c (gfc_compare_derived_types): Ditto. + * trans-array.c (gfc_array_allocate,structure_alloc_comps): Ditto. + * trans-expr.c (gfc_conv_component_ref,gfc_trans_subcomponent_assign, + gfc_conv_structure): Ditto. + * symbol.c (gfc_find_component,free_components,gfc_set_component_attr, + gfc_get_component_attr,verify_bind_c_derived_type, + generate_isocbinding_symbol): Ditto. + * decl.c (build_struct): Ditto. + * dump-parse-tree.c (show_components): Ditto. + * trans-stmt.c (gfc_trans_deallocate): Ditto. + * expr.c (gfc_check_assign,gfc_check_pointer_assign, + gfc_default_initializer): Ditto. + * module.c (mio_component): Ditto. + * trans-types.c (copy_dt_decls_ifequal,gfc_get_derived_type): Ditto. + * resolve.c (has_default_initializer,resolve_structure_cons, + gfc_iso_c_func_interface,find_array_spec,resolve_ref, + resolve_deallocate_expr,resolve_allocate_expr,resolve_fl_derived, + resolve_equivalence_derived): Ditto. + * trans-io.c (transfer_expr): Ditto. + * parse.c (parse_derived): Ditto. + * dependency.c (gfc_check_dependency): Ditto. + * primary.c (gfc_variable_attr): Ditto. + + 2008-08-23 Tobias Burnus + + PR fortran/37076 + * arith.c (gfc_arith_concat): Fix concat of kind=4 strings. + + 2008-08-23 Tobias Burnus + + PR fortran/37025 + * target-memory.c (gfc_interpret_character): Support + kind=4 characters. + + 2008-08-22 Daniel Kraft + + PR fortran/30239 + * symbol.c (gfc_add_type): Warn on -Wsurprising if a function-result + type is re-declared but neither -pedantic nor -std=f* is given and so + this is no error. + * invoke.texi (-Wsurprising): Document this new behaviour. + + 2008-08-22 Daniel Kraft + + * gfortran.h (in_prefix): Removed from this header. + * match.h (gfc_matching_prefix): Moved and renamed from `in_prefix'. + * decl.c (in_prefix): Removed from here. + (gfc_match_prefix): Use new name of `gfc_matching_prefix'. + * symbol.c (gfc_check_symbol_typed): Ditto. + * expr.c (check_typed_ns): New helper variable. + (expr_check_typed_help): New helper method. + (gfc_expr_check_typed): Rewrote to use gfc_traverse_expr to do the + work, fixing a minor problem. + * match.c (gfc_matching_prefix): New variable. + + 2008-08-22 Daniel Kraft + + PR fortran/32095 + PR fortran/34228 + * gfortran.h (in_prefix): New global. + (gfc_check_symbol_typed), (gfc_check_expr_typed): New methods. + * array.c (match_array_element_spec): Check that bounds-expressions + don't have symbols not-yet-typed in them. + * decl.c (var_element): Check that variable used is already typed. + (char_len_param_value): Check that expression does not contain + not-yet-typed symbols. + (in_prefix): New global. + (gfc_match_prefix): Record using `in_prefix' if we're at the moment + parsing a prefix or not. + * expr.c (gfc_expr_check_typed): New method. + * parse.c (verify_st_order): New argument to disable error output. + (check_function_result_typed): New helper method. + (parse_spec): Check that the function-result declaration, if given in + a prefix, contains no not-yet-typed symbols when the IMPLICIT rules are + parsed. + * symbol.c (gfc_check_symbol_typed): Check that a symbol already has + a type associated to it, otherwise use the IMPLICIT rules or signal + an error. + + 2008-08-21 Manuel Lopez-Ibanez + + * f95-lang.c: Update all calls to pedwarn. + + 2008-08-18 Daniel Franke + + PR fortran/37032 + * gfortran.texi: Document decision on include file handling in + preprocessed files. + + 2008-08-16 Tobias Burnus + + PR fortran/36825 + * libgfortran.h: Reduce GFC_MAX_DIMENSIONS to 7. + + 2008-08-15 Jerry DeLisle + + PR fortran/35863 + * io.c (gfc_match_open): Enable UTF-8 in checks. + * simplify.c (gfc_simplify_selected_char_kind): Enable iso_10646. + + 2008-08-14 Janus Weil + + PR fortran/36705 + * symbol.c (check_conflict): Move conflict checks for (procedure,save) + and (procedure,intent) to resolve_fl_procedure. + * resolve.c (resolve_fl_procedure): Ditto. + + 2008-08-09 Manuel Lopez-Ibanez + + PR 36901 + * f95-lang.c (gfc_mark_addressable): Use "pedwarn (0," instead of + 'pedwarn0'. + + 2008-08-09 Paul Thomas + + PR fortran/37011 + * symbol.c (gfc_add_extension): New function. + * decl.c (gfc_get_type_attr_spec): Call it. + (gfc_match_derived_decl): Set symbol extension attribute from + attr.extension. + * gfortran.h : Add prototype for gfc_add_extension. + + 2008-08-08 Manuel Lopez-Ibanez + + PR 28875 + * options.c (set_Wall): Replace set_Wunused by warn_unused. + + 2008-08-08 Daniel Kraft + + * gfortran.h (gfc_finalizer): Replaced member `procedure' by two + new members `proc_sym' and `proc_tree' to store the symtree after + resolution. + (gfc_find_sym_in_symtree): Made public. + * decl.c (gfc_match_final_decl): Adapted for new member name. + * interface.c (gfc_find_sym_in_symtree): Made public. + (gfc_extend_expr), (gfc_extend_assign): Changed call accordingly. + * module.c (mio_finalizer), (mio_f2k_derived), (mio_full_f2k_derived): + New methods for module-file IO of f2k_derived. + (mio_symbol): Do IO of f2k_derived namespace. + * resolve.c (gfc_resolve_finalizers): Adapted for new member name and + finding the symtree for the symbol here. + * symbol.c (gfc_free_finalizer): Adapted for new members. + + 2008-07-30 Ralf Wildenhues + + * gfc-internals.texi: Update to GFDL 1.2. Do not list GPL as + Invariant Section. + * gfortran.texi: Likewise. + * intrinsic.texi: Do not list GPL as Invariant Section. + * invoke.texi: Likewise. Update copyright years. + + 2008-07-29 Paul Thomas + + * trans-expr.c (conv_parent_component_references): New function + to build missing parent references. + (gfc_conv_variable): Call it + * symbol.c (gfc_add_component): Check that component name in a + derived type extension does not appear in parent. + (gfc_find_component): For a derived type extension, check if + the component appears in the parent derived type by calling + self. Separate errors for private components and private types. + * decl.c (match_data_constant): Add extra arg to call to + gfc_match_structure_constructor. + (check_extended_derived_type): New function to check that a + parent derived type exists and that it is OK for exension. + (gfc_get_type_attr_spec): Add extra argument 'name' and return + it if extends is specified. + (gfc_match_derived_decl): Match derived type extension and + build a first component of the parent derived type if OK. Add + the f2k namespace if not present. + * gfortran.h : Add the extension attribute. + * module.c : Handle attribute 'extension'. + * match.h : Modify prototypes for gfc_get_type_attr_spec and + gfc_match_structure_constructor. + * primary.c (build_actual_constructor): New function extracted + from gfc_match_structure_constructor and modified to call self + iteratively to build derived type extensions, when f2k named + components are used. + (gfc_match_structure_constructor): Do not throw error for too + many components if a parent type is being handled. Use + gfc_find_component to generate errors for non-existent or + private components. Iteratively call self for derived type + extensions so that parent constructor is built. If extension + and components left over, throw error. + (gfc_match_rvalue): Add extra arg to call to + gfc_match_structure_constructor. + + * trans-array.c (gfc_conv_resolve_dependencies): If lhs and rhs + are the same symbol, aliassing does not matter. + + 2008-07-29 Jan Hubicka + + * options.c (gfc_post_options): Do not set flag_no_inline. + + 2008-07-29 Daniel Kraft + + PR fortran/36403 + * trans-intrinsic.c (conv_generic_with_optional_char_arg): New method + to append a string-length even if the string argument is missing, e.g. + for EOSHIFT. + (gfc_conv_intrinsic_function): Call the new method for EOSHIFT, PACK + and RESHAPE. + + 2008-07-28 Kaveh R. Ghazi + + * gfortran.h (try): Remove macro. Replace try with gfc_try + throughout. + * array.c: Likewise. + * check.c: Likewise. + * cpp.c: Likewise. + * cpp.h: Likewise. + * data.c: Likewise. + * data.h: Likewise. + * decl.c: Likewise. + * error.c: Likewise. + * expr.c: Likewise. + * interface.c: Likewise. + * intrinsic.c: Likewise. + * intrinsic.h: Likewise. + * io.c: Likewise. + * match.h: Likewise. + * parse.c: Likewise. + * parse.h: Likewise. + * resolve.c: Likewise. + * scanner.c: Likewise. + * simplify.c: Likewise. + * symbol.c: Likewise. + * trans-openmp.c: Likewise. + * trans-types.c: Likewise. + + 2008-07-28 Tobias Burnus + + * Make-lang.in: Remove -Wno-* from fortran-warn. + + 2008-07-28 Richard Guenther + + Merge from gimple-tuples-branch. + + 2008-07-18 Aldy Hernandez + + * trans-expr.c: Include gimple.h instead of tree-gimple.h. + * trans-array.c: Same. + * trans-openmp.c: Same. + * trans-stmt.c: Same. + * f95-lang.c: Same. + * trans-io.c: Same. + * trans-decl.c: Same. + * trans-intrinsic.c: Same. + * trans.c: Same. Include tree-iterator.h. + * Make-lang.in (trans.o): Depend on tree-iterator.h + + 2008-07-14 Aldy Hernandez + + * trans-array.h (gfc_conv_descriptor_data_set_internal): + Rename to gfc_conv_descriptor_data_set. + (gfc_conv_descriptor_data_set_tuples): Remove. + * trans-array.c (gfc_conv_descriptor_data_get): Rename + from gfc_conv_descriptor_data_set_internal. + Remove last argument to gfc_add_modify. + (gfc_trans_allocate_array_storage): Rename gfc_add_modify_expr to + gfc_add_modify. + (gfc_trans_create_temp_array): Same. + (gfc_conv_array_transpose): Same. + (gfc_grow_array): Same. + (gfc_put_offset_into_var): Same. + (gfc_trans_array_ctor_element): Same. + (gfc_trans_array_constructor_subarray): Same. + (gfc_trans_array_constructor_value): Same. + (gfc_trans_scalarized_loop_end): Same. + (gfc_array_init_size): Same. + (gfc_array_allocate): Same. + (gfc_trans_array_bounds): Same. + (gfc_trans_auto_array_allocation): Same. + (gfc_trans_g77_array): Same. + (gfc_trans_dummy_array_bias): Same. + (gfc_conv_expr_descriptor): Same. + (structure_alloc_comps): Same. + * trans-expr.c: Same. + * trans-openmp.c (gfc_omp_clause_default_ctor): Same. + Rename gfc_conv_descriptor_data_set_tuples to + gfc_conv_descriptor_data_set. + (gfc_omp_clause_copy_ctor): Change build_gimple_modify_stmt to + build2_v. + (gfc_omp_clause_assign_op): Same. + (gfc_trans_omp_array_reduction): Rename gfc_add_modify_expr to + gfc_add_modify. + (gfc_trans_omp_atomic): Same. + (gfc_trans_omp_do): Same. Change GIMPLE_MODIFY_STMT to MODIFY_EXPR. + Rename gfc_add_modify_stmt to gfc_add_modify. + * trans-stmt.c: Rename gfc_add_modify_expr to + gfc_add_modify. + * trans.c: Rename gfc_add_modify_expr to + gfc_add_modify. + (gfc_add_modify): Remove last argument. + Rename GIMPLE_MODIFY_STMT to MODIFY_EXPR. + * trans.h: Remove gfc_add_modify_expr, gfc_add_modify_stmt. + Add prototype for gfc_add_modify. + * f95-lang.c (union lang_tree_node): Rename GENERIC_NEXT to TREE_CHAIN. + * trans-decl.c: Rename gfc_add_modify_stmt to gfc_add_modify. + * trans-io.c: Same. + * trans-intrinsic.c: Same. + + 2008-02-25 Aldy Hernandez + + * Make-lang.in (fortran-warn): Add -Wno-format. + + 2008-02-19 Diego Novillo + + http://gcc.gnu.org/ml/gcc-patches/2008-02/msg00804.html + + * fortran/Make-lang.in (fortran-warn): Remove. + + 2007-11-22 Aldy Hernandez + + * trans-expr.c (gfc_trans_string_copy): Use "void *" when building a + memset. + + 2007-11-10 Aldy Hernandez + + * Make-lang.in (fortran-warn): Set to -Wno-format. + * trans.c (gfc_trans_code): Update comment to say GENERIC. + Call tree_annotate_all_with_locus instead of annotate_all_with_locus. + + 2008-07-27 Tobias Burnus + + PR fortran/36132 + PR fortran/29952 + PR fortran/36909 + * trans.c (gfc_trans_runtime_check): Allow run-time warning besides + run-time error. + * trans.h (gfc_trans_runtime_check): Update declaration. + * trans-array.c (gfc_trans_array_ctor_element,gfc_trans_array_bound_check, + gfc_conv_array_ref,gfc_conv_ss_startstride,gfc_trans_dummy_array_bias): + Updated gfc_trans_runtime_check calls. + (gfc_conv_array_parameter): Implement flag_check_array_temporaries, + fix packing/unpacking for nonpresent optional actuals to optional + formals. + * trans-array.h (gfc_conv_array_parameter): Update declaration. + * trans-expr.c (gfc_conv_substring,gfc_trans_arrayfunc_assign, + gfc_conv_function_call): Updated gfc_trans_runtime_check calls. + (gfc_conv_function_call): Update gfc_conv_array_parameter calls. + * trans-expr.c (gfc_trans_goto): Updated gfc_trans_runtime_check + calls. + * trans-io.c (set_string,gfc_conv_intrinsic_repeat): Ditto. + (gfc_conv_intrinsic_transfer,gfc_conv_intrinsic_loc): Same for + gfc_conv_array_parameter. + * trans-intrinsics.c (gfc_conv_intrinsic_bound): Ditto. + * trans-decl.c (gfc_build_builtin_function_decls): Add + gfor_fndecl_runtime_warning_at. + * lang.opt: New option fcheck-array-temporaries. + * gfortran.h (gfc_options): New flag_check_array_temporaries. + * options.c (gfc_init_options, gfc_handle_option): Handle flag. + * invoke.texi: New option fcheck-array-temporaries. + + 2008-07-24 Jan Hubicka + + * fortran/options.c (gfc_post_options): Remove flag_unline_trees code. + + 2008-07-24 Daniel Kraft + + PR fortran/33141 + * lang.opt (Wnonstd-intrinsics): Removed option. + (Wintrinsics-std), (Wintrinsic-shadow): New options. + * invoke.texi (Option Summary): Removed -Wnonstd-intrinsics + from the list and added -Wintrinsics-std and -Wintrinsic-shadow. + (Error and Warning Options): Documented the new options and removed + the documentation for -Wnonstd-intrinsics. + * gfortran.h (gfc_option_t): New members warn_intrinsic_shadow and + warn_intrinsics_std, removed warn_nonstd_intrinsics. + (gfc_is_intrinsic): Renamed from gfc_intrinsic_name. + (gfc_warn_intrinsic_shadow), (gfc_check_intrinsic_standard): New. + * decl.c (match_procedure_decl): Replaced gfc_intrinsic_name by + the new name gfc_is_intrinsic. + (warn_intrinsic_shadow): New helper method. + (gfc_match_function_decl), (gfc_match_subroutine): Call the new method + warn_intrinsic_shadow to check the just-parsed procedure. + * expr.c (check_init_expr): Call new gfc_is_intrinsic to check whether + the function called is really an intrinsic in the selected standard. + * intrinsic.c (gfc_is_intrinsic): Renamed from gfc_intrinsic_name and + extended to take into account the selected standard settings when trying + to find out whether a symbol is an intrinsic or not. + (gfc_check_intrinsic_standard): Made public and extended. + (gfc_intrinsic_func_interface), (gfc_intrinsic_sub_interface): Removed + the calls to check_intrinsic_standard, this check now happens inside + gfc_is_intrinsic. + (gfc_warn_intrinsic_shadow): New method defined. + * options.c (gfc_init_options): Initialize new warning flags to false + and removed intialization of Wnonstd-intrinsics flag. + (gfc_post_options): Removed logic for Wnonstd-intrinsics flag. + (set_Wall): Set new warning flags and removed Wnonstd-intrinsics flag. + (gfc_handle_option): Handle the new flags and removed handling of the + old Wnonstd-intrinsics flag. + * primary.c (gfc_match_rvalue): Replaced call to gfc_intrinsic_name by + the new name gfc_is_intrinsic. + * resolve.c (resolve_actual_arglist): Ditto. + (resolve_generic_f), (resolve_unknown_f): Ditto. + (is_external_proc): Ditto. + (resolve_generic_s), (resolve_unknown_s): Ditto. + (resolve_symbol): Ditto and ensure for symbols declared INTRINSIC that + they are really available in the selected standard setting. + + 2008-07-24 Daniel Kraft + + * match.c (gfc_match): Add assertion to catch wrong calls trying to + match upper-case characters. + + 2008-07-24 Thomas Koenig + + PR fortran/29952 + * gfortran.h: Add "warn_array_temp" to gfc_option_t. + * lang.opt: Add -Warray-temporaries. + * invoke.texi: Document -Warray-temporaries + * trans-array.h (gfc_trans_create_temp_array): Add argument of + type *locus. + (gfc_conv_loop_setup): Likewise. + * trans-array.c (gfc_trans_create_temp_array): If + -Warray-temporaries is given and locus is present, warn about + creation of array temporaries. + (gfc_trans_array_constructor_subarray): Add locus to call + of gfc_conv_loop_setup. + (gfc_trans_array_constructor): Add where argument. Pass where + argument to call of gfc_trans_create_temp_array. + (gfc_add_loop_ss_code): Add where argument. Pass where argument + to recursive call of gfc_add_loop_ss_code and to call of + gfc_trans_array_constructor. + (gfc_conv_loop_setup): Add where argument. Pass where argument + to calls to gfc_add_loop_ss_code and to gfc_trans_create_temp_array. + (gfc_conv_expr_descriptor): Pass location to call of + gfc_conv_loop_setup. + (gfc_conv_array_parameter): If -Warray-temporaries is given, + warn about creation of temporary arrays. + * trans-expr.c (gfc_conv_subref_array_arg): Add where argument + to call to gfc_conv_loop_setup. + (gfc_conv_function_call): Add where argument to call to + gfc_trans_creat_temp_array. + (gfc_trans_subarray_assign): Likewise. + (gfc_trans_assignment_1): Add where argument to call to + gfc_conv_loop_setup. + * trans-stmt.c (gfc_conv_elemental_dependencies): Add where + argument to call to gfc_trans_create_temp_array. + (gfc_trans_call): Add where argument to call to gfc_conv_loop_setup. + (generate_loop_for_temp_to_lhs): Likewise. + (generate_loop_for_rhs_to_temp): Likewise. + (compute_inner_temp_size): Likewise. + (gfc_trans-pointer_assign_need_temp): Likewise. + (gfc_evaluate_where_mask): Likewise. + (gfc_trans_where_assign): Likewise. + (gfc_trans_where_3): Likewise. + * trans-io.c (transfer_srray_component): Add where argument + to function. Add where argument to call to gfc_conv_loop_setup. + (transfer_expr): Add where argument to call to + transfer_array_component. + (gfc_trans_transfer): Add where expression to call to + gfc_conv_loop_setup. + * trans-intrinsic.c (gfc_conv_intrinsic_anyall): Add + where argument to call to gfc_conv_loop_setup. + (gfc_conv_intrinsic_count): Likewise. + (gfc_conv_intrinsic_arith): Likewise. + (gfc_conv_intrinsic_dot_product): Likewise. + (gfc_conv_intrinsic_minmaxloc): Likewise. + (gfc_conv_intrinsic_minmaxval): Likewise. + (gfc_conv_intrinsic_array_transfer): Warn about + creation of temporary array. + Add where argument to call to gfc_trans_create_temp_array. + * options.c (gfc_init_options): Initialize gfc_option.warn_array_temp. + (gfc_handle_option): Set gfc_option.warn_array_temp. + + 2008-07-23 Manuel Lopez-Ibanez + + PR 35058 + * f95-lang.c (gfc_mark_addressable): All calls to pedwarn changed. + + 2008-07-22 Daniel Kraft + + PR fortran/29835 + * io.c (error_element), (format_locus): New static globals. + (unexpected_element): Spelled out this message fully. + (next_char): Keep track of locus when not MODE_STRING. + (next_char_not_space): Remember last parsed element in error_element. + (format_lex): Fix two indentation errors. + (check_format): Use format_locus and possibly error_element for a + slightly better error message on invalid format. + (check_format_string): Set format_locus to start of the string + expression used as format. + + 2008-07-21 Ralf Wildenhues + + * expr.c (gfc_check_pointer_assign): Fix typo in string. + * io.c (check_format): Fix typo in string. Fix comment typos. + * parse.c (gfc_global_used): Likewise. + * resolve.c (resolve_allocate_expr): Likewise. + * symbol.c (gfc_set_default_type): Likewise. + * arith.c: Fix typos in comments. + * array.c: Likewise. + * data.c: Likewise. + * decl.c: Likewise. + * dependency.c: Likewise. + * f95-lang.c: Likewise. + * gfortran.h: Likewise. + * matchexp.c: Likewise. + * module.c: Likewise. + * primary.c: Likewise. + * scanner.c: Likewise. + * trans-array.c: Likewise. + * trans-common.c: Likewise. + * trans-decl.c: Likewise. + * trans-expr.c: Likewise. + * trans-intrinsic.c: Likewise. + * trans-types.c: Likewise. + * trans.c: Likewise. + * trans.h: Likewise. + + 2008-07-19 Tobias Burnus + + PR fortran/36795 + * matchexp.c (gfc_get_parentheses): Remove obsolete workaround, + which caused the generation of wrong code. + + 2008-07-19 Tobias Burnus + + PR fortran/36342 + * scanner.c (load_file): Add argument to destinguish between + true filename and displayed filename. + (include_line,gfc_new_file): Adapt accordingly. + + 2008-07-19 Tobias Burnus + + * check.c (gfc_check_cshift,gfc_check_eoshift,gfc_check_unpack): Add rank + checks for cshift's shift and eoshift's shift and boundary args. + (gfc_check_unpack): Add rank and shape tests for unpack. + + 2008-07-19 Kaveh R. Ghazi + + * gfortran.h (new): Remove macro. + * array.c (gfc_append_constructor, match_array_list, + gfc_match_array_constructor): Likewise. + * bbt.c (insert, gfc_insert_bbt): Likewise. + * decl.c (var_element, top_var_list, top_val_list, gfc_match_data, + get_proc_name): Likewise. + * expr.c (gfc_copy_actual_arglist): Likewise. + * interface.c (compare_actual_formal, check_new_interface, + gfc_add_interface): Likewise. + * intrinsic.c gfc_convert_type_warn, gfc_convert_chartype): + Likewise. + * io.c (match_io_iterator, match_io_list): Likewise. + * match.c (match_forall_header): Likewise. + * matchexp.c (build_node): Likewise. + * module.c (gfc_match_use): Likewise. + * scanner.c (load_file): Likewise. + * st.c (gfc_append_code): Likewise. + * symbol.c (save_symbol_data, gfc_get_sym_tree, gfc_undo_symbols, + gfc_commit_symbols): Likewise. + * trans-common.c (build_field): Likewise. + * trans-decl.c (gfc_finish_var_decl): Likewise. + * trans-expr.c (gfc_free_interface_mapping, + gfc_get_interface_mapping_charlen, gfc_add_interface_mapping, + gfc_finish_interface_mapping, + gfc_apply_interface_mapping_to_expr): Likewise. + * trans.h (gfc_interface_sym_mapping): Likewise. + + 2008-07-19 Kaveh R. Ghazi + + * gfortran.h (operator): Remove macro. + (gfc_namespace, gfc_expr): Avoid C++ keywords. + * arith.c (eval_intrinsic, eval_intrinsic_f2, eval_intrinsic_f3): + Likewise. + * decl.c (access_attr_decl): Likewise. + * dependency.c (gfc_dep_compare_expr): Likewise. + * dump-parse-tree.c (show_expr, show_uop, show_namespace): + Likewise. + * expr.c (gfc_copy_expr, gfc_type_convert_binary, + simplify_intrinsic_op, check_intrinsic_op): Likewise. + * interface.c (fold_unary, gfc_match_generic_spec, + gfc_match_interface, gfc_match_end_interface, + check_operator_interface, check_uop_interfaces, + gfc_check_interfaces, gfc_extend_expr, gfc_extend_assign, + gfc_add_interface, gfc_current_interface_head, + gfc_set_current_interface_head): Likewise. + * iresolve.c (gfc_resolve_dot_product, gfc_resolve_matmul): + Likewise. + * matchexp.c (gfc_get_parentheses, build_node): Likewise. + * module.c (gfc_use_rename, gfc_match_use, find_use_name_n, + number_use_names, mio_expr, load_operator_interfaces, read_module, + write_operator, write_module): Likewise. + * openmp.c (resolve_omp_atomic): Likewise. + * resolve.c (resolve_operator, gfc_resolve_character_operator, + gfc_resolve_uops): Likewise. + * symbol.c (free_uop_tree, gfc_free_namespace): Likewise. + * trans-expr.c (gfc_conv_expr_op): Likewise. + * trans-openmp.c (gfc_trans_omp_atomic): Likewise. + + 2008-07-19 Kaveh R. Ghazi + + * gfortran.h (protected): Remove macro. + * dump-parse-tree.c (show_attr): Avoid C++ keywords. + * expr.c (gfc_check_pointer_assign): Likewise. + * interface.c (compare_parameter_protected): Likewise. + * intrinsic.c (enum class, add_sym, add_sym_0, add_sym_1, + add_sym_1s, add_sym_1m, add_sym_2, add_sym_2s, add_sym_3, + add_sym_3ml, add_sym_3red, add_sym_3s, add_sym_4, add_sym_4s, + add_sym_5s): Likewise. + * match.c (gfc_match_assignment, gfc_match_pointer_assignment): + Likewise. + * module.c (mio_symbol_attribute): Likewise. + * primary.c (match_variable): Likewise. + * resolve.c (resolve_equivalence): Likewise. + * symbol.c (check_conflict, gfc_add_protected, gfc_copy_attr): + Likewise. + * trans-types.c (gfc_get_array_type_bounds): Likewise. + + 2008-07-18 Kaveh R. Ghazi + + * arith.c (eval_type_intrinsic0): Avoid C++ keywords. + * gfortran.h (try, protected, operator, new): Likewise. + + 2008-07-17 Tobias Burnus + + PR fortran/36825 + PR fortran/36824 + * array.c (gfc_match_array_spec): Fix array-rank check. + * resolve.c (resolve_fl_derived): Fix constentness check + for the array dimensions. + + 2008-07-14 Ralf Wildenhues + + * Make-lang.in (gfortranspec.o): Fix dependencies. + + 2008-07-13 Jerry DeLisle + + PR fortran/36725 + * io.c: Add error check for g0 edit descriptor followed by '.'. + + 2008-07-12 Daniel Kraft + + * resolve.c (resolve_fl_derived): Allow pointer components to empty + derived types fixing a missing part of PR fortran/33221. + + 2008-07-10 Daniel Kraft + + * gfc-internals.texi (section gfc_expr): Created documentation about + the gfc_expr internal data structure. + + 2008-07-07 Thomas Koenig + + PR fortran/36670 + * iresolve.c (gfc_resolve_product): Set shape of return + value from array. + (gfc_resolve_sum): Likewise. + + 2008-07-07 Jakub Jelinek + + PR middle-end/36726 + * f95-lang.c (poplevel): Don't ever add subblocks to + global_binding_level. + + 2008-07-02 Janus Weil + Tobias Burnus + Paul Thomas + + PR fortran/32580 + * gfortran.h (struct gfc_symbol): New member "proc_pointer". + * check.c (gfc_check_associated,gfc_check_null): Implement + procedure pointers. + * decl.c (match_procedure_decl): Ditto. + * expr.c (gfc_check_pointer_assign,gfc_check_assign_symbol): Ditto. + * interface.c (compare_actual_formal): Ditto. + * match.h: Ditto. + * match.c (gfc_match_pointer_assignment): Ditto. + * parse.c (parse_interface): Ditto. + * primary.c (gfc_match_rvalue,match_variable): Ditto. + * resolve.c (resolve_fl_procedure): Ditto. + * symbol.c (check_conflict,gfc_add_external,gfc_add_pointer, + gfc_copy_attr,gen_fptr_param,build_formal_args): Ditto. + * trans-decl.c (get_proc_pointer_decl,gfc_get_extern_function_decl, + create_function_arglist): Ditto. + * trans-expr.c (gfc_conv_variable,gfc_conv_function_val, + gfc_conv_function_call,gfc_trans_pointer_assignment): Ditto. + + 2008-07-02 Thomas Koenig + + PR fortran/36590 + PR fortran/36681 + * iresolve.c (resolve_mask_arg): Don't convert mask to + kind=1 logical if it is of that type already. + + 2008-06-29 Thomas Koenig + + PR fortran/36341 + * iresolve.c (gfc_resolve_matmul): Copy shapes + from arguments. + + 2008-06-29 Jerry DeLisle + + * invoke.texi: Add documentation for runtime behavior of + -fno-range-check. + + 2008-06-28 Daniel Kraft + + * gfc-internals.texi (section gfc_code): Extended documentation about + gfc_code in the internal datastructures chapter including details about + how IF, DO and SELECT blocks look like and an example for how the + block-chaining works. + + 2008-06-25 Paul Thomas + + PR fortran/36526 + * interface.c (check_intents): Correct error where the actual + arg was checked for a pointer argument, rather than the formal. + + 2008-06-24 Paul Thomas + + PR fortran/34371 + * expr.c (gfc_check_assign): Change message and locus for + error when conform == 0. + + 2008-06-23 Jakub Jelinek + + PR fortran/36597 + * cpp.c (cpp_define_builtins): Change _OPENMP value to 200805. + + 2008-06-20 Laurynas Biveinis + Tobias Burnus + + PR fortran/34908 + PR fortran/36276 + * scanner.c (preprocessor_line): do not call gfc_free for + current_file->filename if it differs from filename. + + 2008-06-20 Kaveh R. Ghazi + + * arith.c (hollerith2representation): Fix for -Wc++-compat. + * array.c (gfc_get_constructor): Likewise. + * decl.c (gfc_get_data_variable, gfc_get_data_value, gfc_get_data, + create_enum_history, gfc_match_final_decl): Likewise. + * error.c (error_char): Likewise. + * expr.c (gfc_get_expr, gfc_copy_expr): Likewise. + * gfortran.h (gfc_get_charlen, gfc_get_array_spec, + gfc_get_component, gfc_get_formal_arglist, gfc_get_actual_arglist, + gfc_get_namelist, gfc_get_omp_clauses, gfc_get_interface, + gfc_get_common_head, gfc_get_dt_list, gfc_get_array_ref, + gfc_get_ref, gfc_get_equiv, gfc_get_case, gfc_get_iterator, + gfc_get_alloc, gfc_get_wide_string): Likewise. + * interface.c (count_types_test): Likewise. + * intrinsic.c (add_char_conversions, gfc_intrinsic_init_1): + Likewise. + * io.c (gfc_match_open, gfc_match_close, match_filepos, match_io, + gfc_match_inquire, gfc_match_wait): Likewise. + * match.c (gfc_match, match_forall_iterator): Likewise. + * module.c (gfc_get_pointer_info, gfc_get_use_rename, add_fixup, + add_true_name, parse_string, write_atom, quote_string, + mio_symtree_ref, mio_gmp_real, write_common_0): Likewise. + * options.c (gfc_post_options): Likewise. + * primary.c (match_integer_constant, match_hollerith_constant, + match_boz_constant, match_real_constant, + gfc_get_structure_ctor_component, gfc_match_structure_constructor): Likewise. + * scanner.c (gfc_widechar_to_char, add_path_to_list, + add_file_change, load_line, get_file, preprocessor_line, + load_file, unescape_filename, gfc_read_orig_filename): Likewise. + * simplify.c (gfc_simplify_ibits, gfc_simplify_ishft, + gfc_simplify_ishftc): Likewise. + * symbol.c (gfc_get_st_label, gfc_get_namespace, gfc_new_symtree, + gfc_get_uop, gfc_new_symbol, save_symbol_data, gfc_get_gsymbol): + Likewise. + * target-memory.c (gfc_target_interpret_expr): Likewise. + * trans-const.c (gfc_build_wide_string_const): Likewise. + * trans-expr.c (gfc_add_interface_mapping): Likewise. + * trans-intrinsic.c (gfc_conv_intrinsic_conversion, + gfc_conv_intrinsic_int, gfc_conv_intrinsic_lib_function, + gfc_conv_intrinsic_cmplx, gfc_conv_intrinsic_ctime, + gfc_conv_intrinsic_fdate, gfc_conv_intrinsic_ttynam, + gfc_conv_intrinsic_minmax, gfc_conv_intrinsic_minmax_char, + gfc_conv_intrinsic_ishftc, gfc_conv_intrinsic_index_scan_verify, + gfc_conv_intrinsic_merge, gfc_conv_intrinsic_trim): Likewise. + * trans.c (gfc_get_backend_locus): Likewise. + * trans.h (gfc_get_ss): Likewise. + + 2008-06-18 Daniel Kraft + + PR fortran/36517, fortran/36492 + * array.c (gfc_resolve_character_array_constructor): Call + gfc_set_constant_character_len with changed length-chec argument. + * decl.c (gfc_set_constant_character_len): Changed array argument to + be a generic length-checking argument that can be used for correct + checking with typespec and in special cases where the should-be length + is different from the target length. + (build_struct): Call gfc_set_constant_character_len with changed length + checking argument and introduced additional checks for exceptional + conditions on invalid code. + (add_init_expr_to_sym), (do_parm): Call gfc_set_constant_character_len + with changed argument. + * match.h (gfc_set_constant_character_len): Changed third argument to + int for the should-be length rather than bool. + + 2008-06-17 Daniel Kraft + + PR fortran/36112 + * array.c (gfc_resolve_character_array_constructor): Check that all + elements with constant character length have the same one rather than + fixing it if no typespec is given, emit an error if they don't. Changed + return type to "try" and return FAILURE for the case above. + (gfc_resolve_array_constructor): Removed unneeded call to + gfc_resolve_character_array_constructor in this function. + * gfortran.h (gfc_resolve_character_array_constructor): Returns try. + * trans-array.c (get_array_ctor_strlen): Return length of first element + rather than last element. + * resolve.c (gfc_resolve_expr): Handle FAILURE return from + gfc_resolve_character_array_constructor. + + 2008-06-17 Paul Thomas + + PR fortran/34396 + * resolve.c (add_dt_to_dt_list): New function. + (resolve_fl_derived): Call new function for pointer components + and when derived type resolved. + + 2008-06-15 Jerry DeLisle + + PR fortran/36515 + * trans-decl.c (gfc_generate_function_code): Add range_check to options + array. + + 2008-06-15 Ralf Wildenhues + + * gfc-internals.texi: Expand TABs, drop indentation outside examples. + * gfortran.texi: Likewise. + * intrinsic.texi: Likewise. + * invoke.texi: Likewise. + + 2008-06-13 Jerry DeLisle + + PR fortran/35863 + * trans-io.c (gfc_build_io_library_fndecls): Build declaration for + transfer_character_wide which includes passing in the character kind to + support wide character IO. (transfer_expr): If the kind == 4, create the + argument and build the call. + * gfortran.texi: Fix typo. + + 2008-06-13 Tobias Burnus + + PR fortran/36476 + * decl.c (do_parm): Handle init expression for len=*. + + 2008-06-12 Tobias Burnus + + PR fortran/36462 + * trans-intrinsic.c (gfc_conv_intrinsic_index_scan_verify): + Fix passing of the BACK= argument. + + 2008-06-10 Jerry DeLisle + + * cpp.c: Add copyright notice. + * cpp.h: Add copyright notice. + + 2008-06-08 Janus Weil + + PR fortran/36459 + * decl.c (match_procedure_decl): Correctly recognize if the interface + is an intrinsic procedure. + + 2008-06-08 Tobias Burnus + + PR fortran/35830 + * resolve.c (resolve_symbol): Copy more attributes for + PROCEDUREs with interfaces. + + 2008-06-07 Jerry DeLisle + + PR fortran/36420 + PR fortran/36422 + * io.c (check_format): Add new error message for zero width. + Use new error message for FMT_A and with READ, FMT_G. Allow + FMT_G with WRITE except when -std=F95 and -std=F2003. + + 2008-06-07 Tobias Burnus + + PR fortran/36437 + * intrinsic.c (add_functions): Implement c_sizeof. + * trans-intrinsic.c (gfc_conv_intrinsic_sizeof): Do not + create unneeded variable in the scalar case. + * intrinsic.texi: Add C_SIZEOF documentation. + + 2008-06-06 Tobias Burnus + + * intrinsic.texi (BESSEL_J1): Fix BES(S)EL_J1 typo. + + 2008-06-06 Jakub Jelinek + + * scanner.c (skip_free_comments, skip_fixed_comments): Handle tabs. + * parse.c (next_free): Allow tab after !$omp. + (decode_omp_directive): Handle !$omp task, !$omp taskwait + and !$omp end task. + (case_executable): Add ST_OMP_TASKWAIT. + (case_exec_markers): Add ST_OMP_TASK. + (gfc_ascii_statement): Handle ST_OMP_TASK, ST_OMP_END_TASK and + ST_OMP_TASKWAIT. + (parse_omp_structured_block, parse_executable): Handle ST_OMP_TASK. + * gfortran.h (gfc_find_sym_in_expr): New prototype. + (gfc_statement): Add ST_OMP_TASK, ST_OMP_END_TASK and ST_OMP_TASKWAIT. + (gfc_omp_clauses): Add OMP_SCHED_AUTO to sched_kind, + OMP_DEFAULT_FIRSTPRIVATE to default_sharing. Add collapse and + untied fields. + (gfc_exec_op): Add EXEC_OMP_TASK and EXEC_OMP_TASKWAIT. + * f95-lang.c (LANG_HOOKS_OMP_CLAUSE_COPY_CTOR, + LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP, LANG_HOOKS_OMP_CLAUSE_DTOR, + LANG_HOOKS_OMP_PRIVATE_OUTER_REF): Define. + * trans.h (gfc_omp_clause_default_ctor): Add another argument. + (gfc_omp_clause_copy_ctor, gfc_omp_clause_assign_op, + gfc_omp_clause_dtor, gfc_omp_private_outer_ref): New prototypes. + * types.def (BT_ULONGLONG, BT_PTR_ULONGLONG, + BT_FN_BOOL_ULONGLONGPTR_ULONGLONGPTR, + BT_FN_BOOL_BOOL_ULL_ULL_ULL_ULLPTR_ULLPTR, + BT_FN_BOOL_BOOL_ULL_ULL_ULL_ULL_ULLPTR_ULLPTR, + BT_FN_VOID_PTR_PTR, BT_PTR_FN_VOID_PTR_PTR, + BT_FN_VOID_OMPFN_PTR_OMPCPYFN_LONG_LONG_BOOL_UINT): New. + (BT_BOOL): Use integer type with BOOL_TYPE_SIZE rather + than boolean_type_node. + * dump-parse-tree.c (gfc_show_omp_node): Handle EXEC_OMP_TASK, + EXEC_OMP_TASKWAIT, OMP_SCHED_AUTO, OMP_DEFAULT_FIRSTPRIVATE, + untied and collapse clauses. + (gfc_show_code_node): Handle EXEC_OMP_TASK and EXEC_OMP_TASKWAIT. + * trans.c (gfc_trans_code): Handle EXEC_OMP_TASK and + EXEC_OMP_TASKWAIT. + * st.c (gfc_free_statement): Likewise. + * resolve.c (gfc_resolve_blocks, resolve_code): Likewise. + (find_sym_in_expr): Rename to... + (gfc_find_sym_in_expr): ... this. No longer static. + (resolve_allocate_expr, resolve_ordinary_assign): Adjust caller. + * match.h (gfc_match_omp_task, gfc_match_omp_taskwait): New + prototypes. + * openmp.c (resolve_omp_clauses): Allow allocatable arrays in + firstprivate, lastprivate, reduction, copyprivate and copyin + clauses. + (omp_current_do_code): Made static. + (omp_current_do_collapse): New variable. + (gfc_resolve_omp_do_blocks): Compute omp_current_do_collapse, + clear omp_current_do_code and omp_current_do_collapse on return. + (gfc_resolve_do_iterator): Handle collapsed do loops. + (resolve_omp_do): Likewise, diagnose errorneous collapsed do loops. + (OMP_CLAUSE_COLLAPSE, OMP_CLAUSE_UNTIED): Define. + (gfc_match_omp_clauses): Handle default (firstprivate), + schedule (auto), untied and collapse (n) clauses. + (OMP_DO_CLAUSES): Add OMP_CLAUSE_COLLAPSE. + (OMP_TASK_CLAUSES): Define. + (gfc_match_omp_task, gfc_match_omp_taskwait): New functions. + * trans-openmp.c (gfc_omp_private_outer_ref): New function. + (gfc_omp_clause_default_ctor): Add outer argument. For allocatable + arrays allocate them with the bounds of the outer var if outer + var is allocated. + (gfc_omp_clause_copy_ctor, gfc_omp_clause_assign_op, + gfc_omp_clause_dtor): New functions. + (gfc_trans_omp_array_reduction): If decl is allocatable array, + allocate it with outer var's bounds in OMP_CLAUSE_REDUCTION_INIT + and deallocate it in OMP_CLAUSE_REDUCTION_MERGE. + (gfc_omp_predetermined_sharing): Return OMP_CLAUSE_DEFAULT_SHARED + for assumed-size arrays. + (gfc_trans_omp_do): Add par_clauses argument. If dovar is + present in lastprivate clause and do loop isn't simple, + set OMP_CLAUSE_LASTPRIVATE_STMT. If dovar is present in + parallel's lastprivate clause, change it to shared and add + lastprivate clause to OMP_FOR_CLAUSES. Handle collapsed do loops. + (gfc_trans_omp_directive): Adjust gfc_trans_omp_do callers. + (gfc_trans_omp_parallel_do): Likewise. Move collapse clause to + OMP_FOR from OMP_PARALLEL. + (gfc_trans_omp_clauses): Handle OMP_SCHED_AUTO, + OMP_DEFAULT_FIRSTPRIVATE, untied and collapse clauses. + (gfc_trans_omp_task, gfc_trans_omp_taskwait): New functions. + (gfc_trans_omp_directive): Handle EXEC_OMP_TASK and + EXEC_OMP_TASKWAIT. + + 2008-06-04 Janus Weil + + PR fortran/36322 + PR fortran/36275 + * resolve.c (resolve_symbol): Correctly copy the interface for a + PROCEDURE declaration. + + 2008-06-02 Janus Weil + + PR fortran/36361 + * symbol.c (gfc_add_allocatable,gfc_add_dimension, + gfc_add_explicit_interface): Added checks. + * decl.c (attr_decl1): Added missing "var_locus". + * parse.c (parse_interface): Checking for errors. + + 2008-06-02 Daniel Kraft + + * gfortran.h: New statement-type ST_FINAL for FINAL declarations. + (struct gfc_symbol): New member f2k_derived. + (struct gfc_namespace): New member finalizers, for use in the above + mentioned f2k_derived namespace. + (struct gfc_finalizer): New type defined for finalizers linked list. + * match.h (gfc_match_final_decl): New function header. + * decl.c (gfc_match_derived_decl): Create f2k_derived namespace on + constructed symbol node. + (gfc_match_final_decl): New function to match a FINAL declaration line. + * parse.c (decode_statement): match-call for keyword FINAL. + (parse_derived): Parse CONTAINS section and accept FINAL statements. + * resolve.c (gfc_resolve_finalizers): New function to resolve (that is + in this case, check) a list of finalizer procedures. + (resolve_fl_derived): Call gfc_resolve_finalizers here. + * symbol.c (gfc_get_namespace): Initialize new finalizers to NULL. + (gfc_free_namespace): Free finalizers list. + (gfc_new_symbol): Initialize new f2k_derived to NULL. + (gfc_free_symbol): Free f2k_derived namespace. + (gfc_free_finalizer): New function to free a single gfc_finalizer node. + (gfc_free_finalizer_list): New function to free a linked list of + gfc_finalizer nodes. + + 2008-06-02 Daniel Franke + + PR fortran/36375 + PR fortran/36377 + * cpp.c (gfc_cpp_init): Do not initialize builtins if + processing already preprocessed input. + (gfc_cpp_preprocess): Finalize output with newline. + + 2008-05-31 Jerry DeLisle + + * intrinsic.texi: Revert wrong commit. + + 2008-05-31 Steven G. Kargl + + * arith.c (gfc_arith_init_1): Remove now unused r and c variables. + Cleanup numerical inquiry function initialization. + (gfc_arith_done_1): Replace multiple mpfr_clear() invocations with + a single mpfr_clears(). + (gfc_check_real_range): Re-arrange logic to eliminate multiple + unnecessary branching and assignments. + (gfc_arith_times): Use mpfr_clears() in preference to multiple + mpfr_clear(). + (gfc_arith_divide): Ditto. + (complex_reciprocal): Eliminate now unused variables a, re, im. + Cleanup the mpfr abuse. Use mpfr_clears() in preference to + multiple mpfr_clear(). + (complex_pow): Fix comment whitespace. Use mpfr_clears() in + preference to multiple mpfr_clear(). + * simplify.c (gfc_simplify_and): Remove blank line. + (gfc_simplify_atan2): Move error checking earlier to eliminate + a now unnecessay gfc_free_expr(). + (gfc_simplify_bessel_j0): Remove unnecessary gfc_set_model_kind(). + (gfc_simplify_bessel_j1): Ditto. + (gfc_simplify_bessel_jn): Ditto. + (gfc_simplify_bessel_y0): Ditto. + (gfc_simplify_bessel_y1): Ditto. + (gfc_simplify_bessel_yn): Ditto. + (only_convert_cmplx_boz): Eliminate unnecessary duplicate code, and + combine nested if statement rational expressions. + (gfc_simplify_cos): Use mpfr_clears() in preference to multiple + mpfr_clear(). + (gfc_simplify_exp): Ditto. + (gfc_simplify_fraction): Move gfc_set_model_kind() to after the + special case of 0. Use mpfr_clears() in preference to multiple + mpfr_clear(). + (gfc_simplify_gamma): Eliminate unnecessary gfc_set_model_kind(). + (gfc_simplify_lgamma): Ditto. + (gfc_simplify_log10): Ditto. + (gfc_simplify_log): Move gfc_set_model_kind () inside switch + statement. Use mpfr_clears() in preference to multiple mpfr_clear(). + (gfc_simplify_mod): Eliminate now unused variables quot, iquot, + and term. Simplify the mpfr magic. + (gfc_simplify_modulo): Ditto. + (gfc_simplify_nearest): Eliminate unnecessary gfc_set_model_kind(). + (gfc_simplify_scale): Use mpfr_clears() in preference to multiple + mpfr_clear(). + (gfc_simplify_sin): Ditto + (gfc_simplify_sqrt): Ditto + (gfc_simplify_set_exponent): Move gfc_set_model_kind() to after the + special case of 0. Use mpfr_clears() in preference to multiple + mpfr_clear(). + + 2008-05-29 Daniel Franke + + PR target/36348 + * Make-lang.in (F95_OBJS): Added dependency on FORTRAN_TARGET_OBJS. + + 2008-05-29 Francois-Xavier Coudert + + * scanner.c (load_line): Add first_char argument. Don't call ungetc. + (gfc_read_orig_filename): Adjust call to load_line. Don't call + ungetc. + (load_file): Adjust call to load_line. + + 2008-05-28 Janus Weil + + PR fortran/36325 + PR fortran/35830 + * interface.c (gfc_procedure_use): Enable argument checking for + external procedures with explicit interface. + * symbol.c (check_conflict): Fix conflict checking for externals. + (copy_formal_args): Fix handling of arrays. + * resolve.c (resolve_specific_f0, resolve_specific_s0): Fix handling + of intrinsics. + * parse.c (parse_interface): Non-abstract INTERFACE statement implies + EXTERNAL attribute. + + 2008-05-28 Francois-Xavier Coudert + + PR fortran/36319 + * intrinsic.c (gfc_convert_chartype): Don't mark conversion + function as pure. + * trans-array.c (gfc_trans_array_ctor_element): Divide element + size by the size of one character to obtain length. + * iresolve.c (gfc_resolve_cshift): Call the _char4 variant when + appropriate. + (gfc_resolve_eoshift): Likewise. + * trans-intrinsic.c (gfc_conv_intrinsic_ctime): Minor beautification. + (gfc_conv_intrinsic_fdate): Minor beautification. + (gfc_conv_intrinsic_ttynam): Minor beautification. + (gfc_conv_intrinsic_minmax_char): Allow all character kinds. + (size_of_string_in_bytes): New function. + (gfc_conv_intrinsic_size): Call size_of_string_in_bytes for + character expressions. + (gfc_conv_intrinsic_sizeof): Likewise. + (gfc_conv_intrinsic_array_transfer): Likewise. + (gfc_conv_intrinsic_trim): Allow all character kinds. Minor + beautification. + (gfc_conv_intrinsic_repeat): Fix comment typo. + * simplify.c (gfc_convert_char_constant): Take care of conversion + of array constructors. + + 2008-05-27 Tobias Burnus + + PR fortran/36316 + * trans-array.c (gfc_set_loop_bounds_from_array_spec): + Add missing fold_convert. + + 2008-05-26 Daniel Franke + + * fortran/cpp.c (cpp_define_builtins): Remove usage of TARGET_* macros, + added FIXME instead. + + 2008-05-26 Daniel Franke + + PR fortran/18428 + * lang.opt (A, C, CC, D, E, H, P, U, cpp, d, fworking-directory, + imultilib, iprefix, iquote, isysroot, isystem, nocpp, nostdinc, + o, undef, v): New options. + * options.c (gfc_init_options): Also initialize preprocessor + options. + (gfc_post_options): Also handle post-initialization of preprocessor + options. + (gfc_handle_option): Check if option is a preprocessor option. + If yes, let gfc_cpp_handle_option() handle the option. + * lang-specs.h: Reorganized to handle new options. + * scanner.c (gfc_new_file): Read temporary file instead of + input source if preprocessing is enabled. + * f95-lang.c (gfc_init): Initialize preprocessor. + (gfc_finish): Clean up preprocessor. + * cpp.c: New. + * cpp.h: New. + * Make-lang.in: Added new objects and dependencies. + * gfortran.texi: Updated section "Preprocessing and + conditional compilation". + * invoke.texi: Added new section "Preprocessing Options", + listed and documented the preprocessing options handled + by gfortran. + + 2008-05-25 Tobias Burnus + + PR fortran/32600 + * trans-expr.c (gfc_conv_function_call): Remove library + call for c_f_pointer with scalar Fortran pointers and for + c_f_procpointer. + + 2008-05-21 Francois-Xavier Coudert + + PR fortran/36257 + * iresolve.c (check_charlen_present): Don't force the rank to 1. + + 2008-05-19 Francois-Xavier Coudert + + PR fortran/36265 + * trans-expr.c (gfc_conv_string_tmp): Pick the correct type for + the temporary variable. + + 2008-05-19 Francois-Xavier Coudert + + * simplify.c (gfc_simplify_dble, gfc_simplify_real): Initialize + result variable to avoid warnings. + + 2008-05-18 Francois-Xavier Coudert + + * intrinsic.c (char_conversions, ncharconv): New static variables. + (find_char_conv): New function. + (add_functions): Add simplification functions for ADJUSTL and + ADJUSTR. Don't check the kind of their argument. Add checking for + LGE, LLE, LGT and LLT. + (add_subroutines): Fix argument type for SLEEP. Fix argument name + for SYSTEM. + (add_char_conversions): New function. + (gfc_intrinsic_init_1): Call add_char_conversions. + (gfc_intrinsic_done_1): Free char_conversions. + (check_arglist): Use kind == 0 as a signal that we don't want + the kind value to be checked. + (do_simplify): Also simplify character functions. + (gfc_convert_chartype): New function + * trans-array.c (gfc_trans_array_ctor_element): Don't force the + use of default character type. + (gfc_trans_array_constructor_value): Likewise. + (get_array_ctor_var_strlen): Use integer kind to build an integer + instead of a character kind! + (gfc_build_constant_array_constructor): Don't force the use of + default character type. + (gfc_conv_loop_setup): Likewise. + * trans-expr.c (gfc_conv_string_tmp): Don't force the use of + default character type. Allocate enough memory for wide strings. + (gfc_conv_concat_op): Make sure operand kind are the same. + (string_to_single_character): Remove gfc_ prefix. Reindent. + Don't force the use of default character type. + (gfc_conv_scalar_char_value): Likewise. + (gfc_build_compare_string): Call string_to_single_character. + (fill_with_spaces): New function + (gfc_trans_string_copy): Add kind arguments. Use them to deal + with wide character kinds. + (gfc_conv_statement_function): Whitespace fix. Call + gfc_trans_string_copy with new kind arguments. + (gfc_conv_substring_expr): Call gfc_build_wide_string_const + instead of using gfc_widechar_to_char. + (gfc_conv_string_parameter): Don't force the use of default + character type. + (gfc_trans_scalar_assign): Pass kind args to gfc_trans_string_copy. + * intrinsic.h (gfc_check_lge_lgt_lle_llt, gfc_convert_char_constant, + gfc_resolve_adjustl, gfc_resolve_adjustr): New prototypes. + * decl.c (gfc_set_constant_character_len): Don't assert the + existence of a single character kind. + * trans-array.h (gfc_trans_string_copy): New prototype. + * gfortran.h (gfc_check_character_range, gfc_convert_chartype): + New prototypes. + * error.c (print_wide_char_into_buffer): New function lifting + code from gfc_print_wide_char. Fix order to output '\x??' instead + of 'x\??'. + (gfc_print_wide_char): Call print_wide_char_into_buffer. + (show_locus): Call print_wide_char_into_buffer with buffer local + to this function. + * trans-const.c (gfc_build_wide_string_const): New function. + (gfc_conv_string_init): Deal with wide characters strings + constructors. + (gfc_conv_constant_to_tree): Call gfc_build_wide_string_const. + * trans-stmt.c (gfc_trans_label_assign): Likewise. + (gfc_trans_character_select): Deal with wide strings. + * expr.c (gfc_check_assign): Allow conversion between character + kinds on assignment. + * trans-const.h (gfc_build_wide_string_const): New prototype. + * trans-types.c (gfc_get_character_type_len_for_eltype, + gfc_get_character_type_len): Create too variants of the old + gfc_get_character_type_len, one getting kind argument and the + other one directly taking a type tree. + * trans.h (gfor_fndecl_select_string_char4, + gfor_fndecl_convert_char1_to_char4, + gfor_fndecl_convert_char4_to_char1): New prototypes. + * trans-types.h (gfc_get_character_type_len_for_eltype): New + prototype. + * resolve.c (resolve_operator): Exit early when kind mismatches + are detected, because that makes us issue an error message later. + (validate_case_label_expr): Fix wording of error message. + * iresolve.c (gfc_resolve_adjustl, gfc_resolve_adjustr): New + functions. + (gfc_resolve_pack): Call _char4 variants of library function + when dealing with wide characters. + (gfc_resolve_reshape): Likewise. + (gfc_resolve_spread): Likewise. + (gfc_resolve_transpose): Likewise. + (gfc_resolve_unpack): Likewise. + * target-memory.c (size_character): Take character kind bit size + correctly into account (not that it changes anything for now, but + it's more generic). + (gfc_encode_character): Added gfc_ prefix. Encoding each + character of a string by calling native_encode_expr for the + corresponding unsigned integer. + (gfc_target_encode_expr): Add gfc_ prefix to encode_character. + * trans-decl.c (gfc_build_intrinsic_function_decls): Build + gfor_fndecl_select_string_char4, gfor_fndecl_convert_char1_to_char4 + and gfor_fndecl_convert_char4_to_char1. + * target-memory.h (gfc_encode_character): New prototype. + * arith.c (gfc_check_character_range): New function. + (eval_intrinsic): Allow non-default character kinds. + * check.c (gfc_check_access_func): Only allow default + character kind arguments. + (gfc_check_chdir): Likewise. + (gfc_check_chdir_sub): Likewise. + (gfc_check_chmod): Likewise. + (gfc_check_chmod_sub): Likewise. + (gfc_check_lge_lgt_lle_llt): New function. + (gfc_check_link): Likewise. + (gfc_check_link_sub): Likewise. + (gfc_check_symlnk): Likewise. + (gfc_check_symlnk_sub): Likewise. + (gfc_check_rename): Likewise. + (gfc_check_rename_sub): Likewise. + (gfc_check_fgetputc_sub): Likewise. + (gfc_check_fgetput_sub): Likewise. + (gfc_check_stat): Likewise. + (gfc_check_stat_sub): Likewise. + (gfc_check_date_and_time): Likewise. + (gfc_check_ctime_sub): Likewise. + (gfc_check_fdate_sub): Likewise. + (gfc_check_gerror): Likewise. + (gfc_check_getcwd_sub): Likewise. + (gfc_check_getarg): Likewise. + (gfc_check_getlog): Likewise. + (gfc_check_hostnm): Likewise. + (gfc_check_hostnm_sub): Likewise. + (gfc_check_ttynam_sub): Likewise. + (gfc_check_perror): Likewise. + (gfc_check_unlink): Likewise. + (gfc_check_unlink_sub): Likewise. + (gfc_check_system_sub): Likewise. + * primary.c (got_delim): Perform correct character range checking + for all kinds. + * trans-intrinsic.c (gfc_conv_intrinsic_conversion): Generate + calls to library functions convert_char4_to_char1 and + convert_char1_to_char4 for character conversions. + (gfc_conv_intrinsic_char): Allow all character kings. + (gfc_conv_intrinsic_strcmp): Fix whitespace. + (gfc_conv_intrinsic_repeat): Take care of all character kinds. + * intrinsic.texi: For all GNU intrinsics accepting character + arguments, mention that they're restricted to the default kind. + * simplify.c (simplify_achar_char): New function. + (gfc_simplify_achar, gfc_simplify_char): Call simplify_achar_char. + gfc_simplify_ichar): Don't error out for wide characters. + (gfc_convert_char_constant): New function. + + 2008-05-18 Steven G. Kargl + + PR fortran/36251 + * symbol.c (check_conflict): Issue errors for abuse of PUBLIC, PRIVATE, + and BIND(C). + * resolve.c (gfc_verify_binding_labels): Fix NULL pointer dereference. + + 2008-05-17 Tobias Burnus + + * intrinsic.texi: Correct description of GET_COMMAND_ARGUMENT + and GET_ENVIRONMENT_VARIABLE; fix keyword= name for GETENV, + GETLOG, GMTIME, HOSTNM, IRAND, ITIME, KILL. + Move LOG_GAMMA after LOG10. + + 2008-05-17 Tobias Burnus + + * intrinsic.c (add_functions): Change FLUSH(C) to FLUSH(UNIT). + * intrinsic.texi: Change INTEGER(*) to INTEGER; fix keyword= name for + ABS, ADJUSTL, AINT, ALLOCATED, ANINT, ASSOCIATED, C_ASSOCIATED, + CEILING, DBLE, DFLOAT, DOT_PRODUCT, DREAL, FLOAT, FLOOR, GET_COMMAND. + + 2008-05-16 Paul Thomas + + PR fortran/35756 + PR fortran/35759 + * trans-stmt.c (gfc_trans_where): Tighten up the dependency + check for calling gfc_trans_where_3. + + PR fortran/35743 + * trans-stmt.c (gfc_trans_where_2): Set the mask size to zero + if it is calculated to be negative. + + PR fortran/35745 + * trans-stmt.c (gfc_trans_where_3, gfc_trans_where_assign): Set + ss->where for scalar right hand sides. + * trans-array.c (gfc_add_loop_ss_code): If ss->where is set do + not evaluate scalars outside the loop. Clean up whitespace. + * trans.h : Add a bitfield 'where' to gfc_ss. + + 2008-05-16 Tobias Burnus + + * libgfortran.h: Increase GFC_MAX_DIMENSIONS to 15. + * array.c (gfc_match_array_spec): Error with -std=f2003 if rank > 7. + + 2008-04-16 Daniel Kraft + + PR fortran/27997 + * gfortran.h: Added field "length_from_typespec" to gfc_charlength. + * aray.c (gfc_match_array_constructor): Added code to parse typespec. + (check_element_type, check_constructor_type, gfc_check_constructor_type): + Extended to support explicit typespec on constructor. + (gfc_resolve_character_array_constructor): Pad strings correctly for + explicit, constant character length. + * trans-array.c: New static global variable "typespec_chararray_ctor" + (gfc_trans_array_constructor): New code to support explicit but dynamic + character lengths. + + 2008-05-16 Jerry DeLisle + + PR fortran/34325 + * decl.c (match_attr_spec): Check for matching pairs of parenthesis. + * expr.c (gfc_specification_expr): Supplement the error message with the + type that was found. + * resolve.c (gfc_resolve_index): Likewise. + * match.c (gfc_match_parens): Clarify error message with "at or before". + (gfc_match_do): Check for matching pairs of parenthesis. + + 2008-05-16 Tobias Burnus + + * primary.c: New private structure "gfc_structure_ctor_component". + (gfc_free_structure_ctor_component): New helper function. + (gfc_match_structure_constructor): Extended largely to support named + arguments and default initialization for structure constructors. + + 2008-05-15 Steven G. Kargl + + * simplify.c (gfc_simplify_dble, gfc_simplify_float, + simplify_bound, gfc_simplify_nearest, gfc_simplify_real): Plug + possible memory leaks. + (gfc_simplify_reshape): Plug possible memory leaks and dereferencing + of NULL pointers. + + 2008-05-15 Steven G. Kargl + + PR fortran/36239 + * simplify.c (gfc_simplify_int, gfc_simplify_intconv): Replaced hand + rolled integer conversion with gfc_int2int, gfc_real2int, and + gfc_complex2int. + (gfc_simplify_intconv): Renamed to simplify_intconv. + + 2008-05-15 Steven G. Kargl, + * gfortran.dg/and_or_xor.f90: New test + + * fortran/simplify.c (gfc_simplify_and, gfc_simplify_or, + gfc_simplify_xor): Don't range check logical results. + + 2008-05-15 Francois-Xavier Coudert + + * trans-expr.c (gfc_conv_concat_op): Take care of nondefault + character kinds. + (gfc_build_compare_string): Add kind argument and use it. + (gfc_conv_statement_function): Fix indentation. + * gfortran.h (gfc_character_info): New structure. + (gfc_character_kinds): New array. + * trans-types.c (gfc_character_kinds, gfc_character_types, + gfc_pcharacter_types): New array. + (gfc_init_kinds): Fill character kinds array. + (validate_character): Take care of nondefault character kinds. + (gfc_build_uint_type): New function. + (gfc_init_types): Take care of nondefault character kinds. + (gfc_get_char_type, gfc_get_pchar_type): New functions. + (gfc_get_character_type_len): Use gfc_get_char_type. + * trans.h (gfc_build_compare_string): Adjust prototype. + (gfor_fndecl_compare_string_char4, gfor_fndecl_concat_string_char4, + gfor_fndecl_string_len_trim_char4, gfor_fndecl_string_index_char4, + gfor_fndecl_string_scan_char4, gfor_fndecl_string_verify_char4, + gfor_fndecl_string_trim_char4, gfor_fndecl_string_minmax_char4, + gfor_fndecl_adjustl_char4, gfor_fndecl_adjustr_char4): New + prototypes. + * trans-types.h (gfc_get_char_type, gfc_get_pchar_type): New + prototypes. + * trans-decl.c (gfor_fndecl_compare_string_char4, + gfor_fndecl_string_len_trim_char4, gfor_fndecl_string_index_char4, + gfor_fndecl_string_scan_char4, gfor_fndecl_string_verify_char4, + gfor_fndecl_string_trim_char4, gfor_fndecl_string_minmax_char4, + gfor_fndecl_adjustl_char4, gfor_fndecl_adjustr_char4, + gfor_fndecl_concat_string_char4): New function decls. + (gfc_build_intrinsic_function_decls): Define new *_char4 function + decls. + * trans-intrinsic.c (gfc_conv_intrinsic_minmax_char, + gfc_conv_intrinsic_len_trim, gfc_conv_intrinsic_ichar, + gfc_conv_intrinsic_strcmp, gfc_conv_intrinsic_trim, + gfc_conv_intrinsic_function): Deal with nondefault character kinds. + + 2008-05-15 Sa Liu + + * iso-c-binding.def: Add standard parameter to macro NAMED_INTCST. + All existing NAMED_INTCST definitions has standard GFC_STD_F2003, + c_int128_t, c_int_least128_t and c_int_fast128_t are added as + GNU extensions. + * iso-fortran-evn.def: Add standard parameter GFC_STD_F2003 + to macro NAMED_INTCST. + * symbol.c (std_for_isocbinding_symbol): New helper function to + return the standard that supports this isocbinding symbol. + (generate_isocbinding_symbol): Do not generate GNU extension symbols + if std=f2003. Add new parameter to NAMED_INTCST. + * module.c (use_iso_fortran_env_module): Add new parameter to + NAMED_INTCST and new field standard to struct intmod_sym. + * gfortran.h: Add new parameter to NAMED_INTCST. + * trans-types.c (init_c_interop_kinds): Add new parameter to + NAMED_INTCST. + * intrinsic.texi: Documented new types C_INT128_T, C_INT_LEASE128_T + and C_INT_FAST128_T. + + 2008-05-14 Francois-Xavier Coudert + + PR fortran/36059 + * trans-decl.c (gfc_build_dummy_array_decl): Don't repack + arrays that have the TARGET attribute. + + 2008-05-14 Francois-Xavier Coudert + + PR fortran/36186 + * simplify.c (only_convert_cmplx_boz): New function. + (gfc_simplify_cmplx, gfc_simplify_complex, gfc_simplify_dcmplx): + Call only_convert_cmplx_boz. + + 2008-05-14 Paul Thomas + + PR fortran/36233 + * interface.c (compare_actual_formal): Do not check sizes if the + actual is BT_PROCEDURE. + + 2008-05-14 Francois-Xavier Coudert + + PR fortran/35682 + * trans-array.c (gfc_conv_ss_startstride): Any negative size is + the same as zero size. + (gfc_conv_loop_setup): Fix size calculation. + + 2008-05-14 Francois-Xavier Coudert + + PR fortran/35685 + * trans-intrinsic.c (gfc_conv_intrinsic_bound): Correctly + handle zero-size sections. + + 2008-05-14 Francois-Xavier Coudert + + PR fortran/36215 + * scanner.c (preprocessor_line): Allocate enough memory for a + wide string. + + 2008-05-12 Francois-Xavier Coudert + + PR fortran/36176 + * target-memory.c (gfc_target_expr_size): Correctly treat + substrings. + (gfc_target_encode_expr): Likewise. + (gfc_interpret_complex): Whitespace change. + + 2008-05-11 Thomas Koenig + + PR fortran/35719 + * trans.c (gfc_call_malloc): If size equals zero, allocate one + byte; don't return a null pointer. + + 2008-05-10 Francois-Xavier Coudert + + PR fortran/36197 + * module.c (quote_string): Fix sprintf format. + + 2008-05-09 Francois-Xavier Coudert + + PR fortran/36162 + * module.c (quote_string, unquote_string, + mio_allocated_wide_string): New functions. + (mio_expr): Call mio_allocated_wide_string where needed. + + 2008-05-07 Kenneth Zadeck + + * trans-decl.c (gfc_get_extern_function_decl, build_function_decl): + Rename DECL_IS_PURE to DECL_PURE_P. + + 2008-05-06 Francois-Xavier Coudert + + * arith.c: (gfc_arith_concat, gfc_compare_string, + gfc_compare_with_Cstring, hollerith2representation, + gfc_hollerith2int, gfc_hollerith2real, gfc_hollerith2complex, + gfc_hollerith2character, gfc_hollerith2logical): Use wide + characters for character constants. + * data.c (create_character_intializer): Likewise. + * decl.c (gfc_set_constant_character_len): Likewise. + * dump-parse-tree.c (show_char_const): Correctly dump wide + character strings. + error.c (print_wide_char): Rename into gfc_print_wide_char. + (show_locus): Adapt to new prototype of gfc_print_wide_char. + expr.c (free_expr0): Representation is now disjunct from + character string value, so we always free it. + (gfc_copy_expr, find_substring_ref, gfc_simplify_expr): Adapt + to wide character strings. + * gfortran.h (gfc_expr): Make value.character.string a wide string. + (gfc_wide_toupper, gfc_wide_strncasecmp, gfc_wide_memset, + gfc_widechar_to_char, gfc_char_to_widechar): New prototypes. + (gfc_get_wide_string): New macro. + (gfc_print_wide_char): New prototype. + * io.c (format_string): Make a wide string. + (next_char, gfc_match_format, compare_to_allowed_values, + gfc_match_open): Deal with wide strings. + * module.c (mio_expr): Convert between wide strings and ASCII ones. + * primary.c (match_hollerith_constant, match_charkind_name): + Handle wide strings. + * resolve.c (build_default_init_expr): Likewise. + * scanner.c (gfc_wide_toupper, gfc_wide_memset, + gfc_char_to_widechar): New functions. + (wide_strchr, gfc_widechar_to_char, gfc_wide_strncasecmp): + Changes in prototypes. + (gfc_define_undef_line, load_line, preprocessor_line, + include_line, load_file, gfc_read_orig_filename): Handle wide + strings. + * simplify.c (gfc_simplify_achar, gfc_simplify_adjustl, + gfc_simplify_adjustr, gfc_simplify_char, gfc_simplify_iachar, + gfc_simplify_ichar, simplify_min_max, gfc_simplify_new_line, + gfc_simplify_repeat): Handle wide strings. + (wide_strspn, wide_strcspn): New helper functions. + (gfc_simplify_scan, gfc_simplify_trim, gfc_simplify_verify): + Handle wide strings. + * symbol.c (generate_isocbinding_symbol): Likewise. + * target-memory.c (size_character, gfc_target_expr_size, + encode_character, gfc_target_encode_expr, gfc_interpret_character, + gfc_target_interpret_expr): Handle wide strings. + * trans-const.c (gfc_conv_string_init): Lower wide strings to + narrow ones. + (gfc_conv_constant_to_tree): Likewise. + * trans-expr.c (gfc_conv_substring_expr): Handle wide strings. + * trans-io.c (gfc_new_nml_name_expr): Likewise. + * trans-stmt.c (gfc_trans_label_assign): Likewise. + + 2008-05-06 Francois-Xavier Coudert + + * simplify.c (gfc_simplify_bessel_j0,gfc_simplify_bessel_j1, + gfc_simplify_bessel_jn,gfc_simplify_bessel_y0, + gfc_simplify_bessel_y1,gfc_simplify_bessel_yn): Mark arguments + with ATTRIBUTE_UNUSED. + + 2008-05-06 Francois-Xavier Coudert + + * check.c (gfc_check_sizeof): Switch to ATTRIBUTE_UNUSED. + * simplify.c (gfc_simplify_lgamma): Likewise. + + 2008-05-06 Francois-Xavier Coudert + + * openmp.c (gfc_match_omp_eos): Use gfc_next_ascii_char and + gfc_peek_ascii_char. + * decl.c (gfc_match_kind_spec, gfc_match_type_spec, + gfc_match_implicit_none, match_implicit_range, gfc_match_implicit, + match_string_p, match_attr_spec, gfc_match_suffix, + match_procedure_decl, gfc_match_entry, gfc_match_subroutine): + Likewise. + * gfortran.h (gfc_char_t): New type. + (gfc_linebuf): Make line member a gfc_char_t. + (locus): Make nextc member a gfc_char_t. + (gfc_wide_is_printable, gfc_wide_is_digit, gfc_wide_fits_in_byte, + gfc_wide_tolower, gfc_wide_strlen, gfc_next_ascii_char, + gfc_peek_ascii_char, gfc_check_digit): New prototypes. + * error.c (print_wide_char): New function. + (show_locus): Use print_wide_char and gfc_wide_strlen. + * io.c (next_char): Use gfc_char_t type. + (match_io): Use gfc_peek_ascii_char and gfc_next_ascii_char. + * match.c (gfc_match_parens, gfc_match_eos, + gfc_match_small_literal_int, gfc_match_name, gfc_match_name_C, + gfc_match_intrinsic_op, gfc_match_char, gfc_match_return, + gfc_match_common): Likewise. + * match.h (gfc_match_special_char): Change prototype. + * parse.c (decode_specification_statement, decode_statement, + decode_omp_directive, next_free, next_fixed): Use + gfc_peek_ascii_char and gfc_next_ascii_char. + * primary.c (gfc_check_digit): Change name. + (match_digits, match_hollerith_constant, match_boz_constant, + match_real_constant, next_string_char, match_charkind_name, + match_string_constant, match_logical_constant_string, + match_complex_constant, match_actual_arg, match_varspec, + gfc_match_rvalue, match_variable): Use gfc_peek_ascii_char and + gfc_next_ascii_char. + * scanner.c (gfc_wide_fits_in_byte, wide_is_ascii, + gfc_wide_is_printable, gfc_wide_tolower, gfc_wide_is_digit, + gfc_wide_is_digit, wide_atoi, gfc_wide_strlen, wide_strcpy, + wide_strchr, widechar_to_char, wide_strncmp, wide_strncasecmp, + gfc_next_ascii_char, gfc_peek_ascii_char): + New functions. + (next_char, gfc_define_undef_line, skip_free_comments, + gfc_next_char_literal, gfc_next_char, gfc_peek_char, + gfc_error_recovery, load_line, preprocessor_line, include_line, + load_file, gfc_read_orig_filename): Use gfc_char_t for source + characters and the {gfc_,}wide_* functions to manipulate wide + strings. + + 2008-05-06 Tobias Burnus + + PR fortran/36117 + * intrinsic.c (add_functions): Call gfc_simplify_bessel_*. + * intrinsic.h: Add prototypes for gfc_simplify_bessel_*. + * simplify.c (gfc_simplify_bessel_j0,gfc_simplify_bessel_j1, + gfc_simplify_bessel_jn,gfc_simplify_bessel_y0, + gfc_simplify_bessel_y1,gfc_simplify_bessel_yn): New. + + 2008-05-03 Janus Weil + + * misc.c (gfc_clear_ts): Set interface to NULL. + + 2008-05-03 Jerry DeLisle + + PR fortran/33268 + * gfortran.h: Add extra_comma pointer to gfc_dt structure. Add iokind to + gfc_expr value union. Add io_kind enum to here from io.c. + * io.c (gfc_free_dt): Free extra_comma. + (gfc_resolve_dt): If an extra comma was encountered and io_unit is type + BT_CHARACTER, resolve to format_expr and set default unit. Error if + io_kind is M_WRITE. (match_io): Match the extra comma and set new + pointer, extra_comma. + + 2008-05-01 Bud Davis + + PR35940/Fortran + * simplify.c (gfc_simplify_index): Check for direction argument + being a constant. + + 2008-05-01 Janus Weil + + * gfortran.h (struct gfc_symbol): Moving "interface" member to + gfc_typespec (plus fixing a small docu error). + * interface.c (gfc_procedure_use): Ditto. + * decl.c (match_procedure_decl): Ditto. + * resolve.c (resolve_specific_f0, + resolve_specific_f0, resolve_symbol): Ditto. + + 2008-04-30 Francois-Xavier Coudert + + * intrinsic.c (add_functions): Add SELECTED_CHAR_KIND intrinsic. + * intrinsic.h (gfc_check_selected_char_kind, + gfc_simplify_selected_char_kind): New prototypes. + * gfortran.h (gfc_isym_id): Add GFC_ISYM_SC_KIND. + * trans.h (gfor_fndecl_sc_kind): New function decl. + * trans-decl.c (gfor_fndecl_sc_kind): Build new decl. + * arith.c (gfc_compare_with_Cstring): New function. + * arith.h (gfc_compare_with_Cstring): New prototype. + * check.c (gfc_check_selected_char_kind): New function. + * primary.c (match_string_constant, match_kind_param): Mark + symbols used as literal constant kind param as referenced. + * trans-intrinsic.c (gfc_conv_intrinsic_sc_kind): New function. + (gfc_conv_intrinsic_function): Call gfc_conv_intrinsic_sc_kind. + * intrinsic.texi (SELECTED_CHAR_KIND): Document new intrinsic. + * simplify.c (gfc_simplify_selected_char_kind): New function. + + 2008-04-28 Paul Thomas + + PR fortran/35997 + * module.c (find_symbol): Do not return a result for a symbol + that has been renamed in another module. + + 2008-04-26 George Helffrich + + PR fortran/35892 + PR fortran/35154 + * trans-common.c (create_common): Add decl to function + chain (if inside one) to preserve identifier scope in debug output. + + 2008-04-25 Jan Hubicka + + * trans-decl.c (trans_function_start): Update. + + 2008-04-25 Tobias Burnus + Daniel Franke + + PR fortran/35156 + * gfortranspec.c (lang_specific_driver): Deprecate + -M option; fix ICE when "-M" is last argument and + make "-M" work. + * options.c (gfc_handle_module_path_options): + Use -J instead of -M in error messages. + * invoke.texi: Mark -M as depecated. + + 2008-04-23 Jerry DeLisle + Francois-Xavier Coudert + + PR fortran/35994 + * trans-instrinsic.c (gfc_conv_intrinsic_minmaxloc): Correctly adjust + loop counter offset. + + 2008-04-23 Paolo Bonzini + + * trans-expr.c (gfc_conv_structure): Don't set TREE_INVARIANT. + * trans-array.c (gfc_build_null_descriptor): Don't set TREE_INVARIANT. + (gfc_trans_array_constructor_value): Don't set TREE_INVARIANT. + (gfc_build_constant_array_constructor): Don't set TREE_INVARIANT. + (gfc_conv_array_initializer): Don't set TREE_INVARIANT. + * trans-common.c (get_init_field): Don't set TREE_INVARIANT. + (create_common): Don't set TREE_INVARIANT. + * trans-stmt.c (gfc_trans_character_select): Don't set TREE_INVARIANT. + * trans-decl.c (gfc_generate_function_code): Don't set TREE_INVARIANT. + + 2008-04-21 Steve Ellcey + + * f95-lang.c (gfc_init_decl_processing): use ptr_mode instead of Pmode. + + 2008-04-21 Daniel Franke + + PR fortran/35019 + * gfortranspec.c (lookup_option): Properly handle separated arguments + in -J option, print missing argument message when necessary. + + 2008-04-20 Jerry DeLisle + + PR fortran/35882 + * scanner.c (skip_fixed_comments): Update continue_line when comment is + detected. (gfc_next_char_literal): Likewise. + + 2008-04-19 Paul Thomas + + PR fortran/35944 + PR fortran/35946 + PR fortran/35947 + * trans_array.c (gfc_trans_array_constructor): Temporarily + realign loop, if loop->from is not zero, before creating + the temporary array and provide an offset. + + PR fortran/35959 + * trans-decl.c (gfc_init_default_dt): Add gfc_ prefix to name + and allow for NULL body. Change all references from + init_default_dt to gfc_init_default_dt. + * trans.h : Add prototype for gfc_init_default_dt. + * trans-array.c (gfc_trans_deferred_vars): After nullification + call gfc_init_default_dt for derived types with allocatable + components. + + 2008-04-18 Jerry DeLisle + + PR fortran/35892 + * trans-common.c (create_common): Revert patch causing regression. + + 2008-04-16 Jerry DeLisle + + PR fortran/35724 + * iresolve.c (gfc_resolve_eoshift): Check for NULL symtree in test for + optional argument attribute. + + 2008-04-16 Paul Thomas + + PR fortran/35932 + * trans-intrinsic.c (gfc_conv_intrinsic_char): Even though KIND + is not used, the argument must be converted. + + 2008-04-16 Jakub Jelinek + + PR target/35662 + * f95-lang.c (gfc_init_builtin_functions): Make sure + BUILT_IN_SINCOS{,F,L} types aren't varargs. + + 2008-04-15 Paul Thomas + + PR fortran/35864 + * expr.c (scalarize_intrinsic_call): Reorder identification of + array argument so that if one is not found a segfault does not + occur. Return FAILURE if all scalar arguments. + + 2008-04-13 Jerry DeLisle + Tobias Burnus + + PR fortran/35882 + * options.c (gfc_init_options): Set the default maximum continuation + lines to 255 for both free and fixed form source for warnings. + (gfc_handle_option): Set -std=f95 fixed form max continuations to 19 and + the -std=f95 free form max continuations to 39 for warnings. + * scanner.c (gfc_next_char_literal): Adjust the current_line number only + if it is less than the current locus. + + 2008-04-07 Jerry DeLisle + + PR fortran/25829 28655 + * io.c (io_tag): Add new tags for decimal, encoding, asynchronous, + round, sign, and id. (match_open_element): Match new tags. + (gfc_resolve_open): Resolve new tags. (gfc_match_open): Enable encoding + for DEFAULT only. Update error messages. (match_dt_element): Fix match + tag for asynchronous. Update error messages. (gfc_free_inquire): Free + new expressions. (match_inquire_element): Match new tags. + (gfc_match_inquire): Add constraint for ID and PENDING. + (gfc_resolve_inquire): Resolve new tags. + * trans-io.c (gfc_trans_inquire): Clean up whitespace and fix setting of + mask for ID parameter. + * ioparm.def: Fix order of parameters for pending, round, and sign. + NOTE: These must line up with the definitions in libgfortran/io/io.h. or + things don't work. + + 2008-04-06 Paul Thomas + + PR fortran/35780 + * expr.c (scalarize_intrinsic_call): Identify which argument is + an array and use that as the template. + (check_init_expr): Remove tests that first argument is an array + in the call to scalarize_intrinsic_call. + + 2008-04-06 Tobias Schlüter + + PR fortran/35832 + * io.c (io_tag): Add field 'value'. Split 'spec' field in + existing io_tags. + (match_etag, match_vtag, match_ltag): Split parsing in two steps + to give better error messages. + + 2008-04-06 Tobias Burnus + + * io.c (check_io_constraints): Add constrains. ID= requires + asynchronous= and asynchronous= must be init expression. + + 2008-04-06 Francois-Xavier Coudert + + * f95-lang.c: Set LANG_HOOKS_NAME to "GNU Fortran". + + 2008-04-06 Francois-Xavier Coudert + + * dump-parse-tree.c: Use fprintf, fputs and fputc instead of + gfc_status and gfc_status_char. Remove gfc_ prefix of the gfc_show_* + functions and make them static. Add new gfc_dump_parse_tree + function. + * gfortran.h (gfc_option_t): Rename verbose into dump_parse_tree. + (gfc_status, gfc_status_char): Delete prototypes. + * error.c (gfc_status, gfc_status_char): Remove functions. + * scanner.c (gfc_new_file): Use printf instead of gfc_status. + * options.c (gfc_init_options): Rename verbose into dump_parse_tree. + (gfc_handle_module_path_options): Use gfc_fatal_error instead of + gfc_status and exit. + (gfc_handle_option): Rename verbose into dump_parse_tree. + * parse.c (gfc_parse_file): Use gfc_dump_parse_tree. + + 2008-04-05 Jerry DeLisle + Francois-Xavier Coudert + + PR fortran/25829 28655 + * dump-parse-tree.c (gfc_show_code_node): Show new I/O parameters. + * gfortran.h (gfc_statement): Add ST_WAIT enumerator. + (gfc_open): Add pointers for decimal, encoding, round, sign, + asynchronous. (gfc_inquire): Add pointers for asynchronous, decimal, + encoding, pending, round, sign, size, id. + (gfc_wait): New typedef struct. (gfc_dt): Add pointers for id, pos, + asynchronous, blank, decimal, delim, pad, round, sign. + (gfc_exec_op): Add EXEC_WAIT enumerator. (gfc_code): Add pointer for + wait. (gfc_free_wait), (gfc_resolve_wait): New function prototypes. + * trans-stmt.h (gfc_trans_wait): New function prototype. + * trans.c (gfc_trans_code): Add case for EXEC_WAIT. + * io.c (io_tag): Add new tags for DECIMAL, ENCODING, ROUND, SIGN, + ASYCHRONOUS, ID. (match_open_element): Add matchers for new tags. + (gfc_free_open): Free new pointers. (gfc_resolve_open): Resolve new + tags. (gfc_resolve_open): Remove comment around check for allowed + values and ASYNCHRONOUS, update it. Likewise for DECIMAL, ENCODING, + ROUND, and SIGN. (match_dt_element): Add matching for new tags. + (gfc_free_wait): New function. (gfc_resolve_wait): New function. + (match_wait_element): New function. (gfc_match_wait): New function. + * resolve.c (gfc_resolve_blocks): Add case for EXEC_WAIT. + (resolve_code): Add case for EXEC_WAIT. + * st.c (gfc_free_statement): Add case for EXEC_WAIT. + * trans-io.c (ioparam_type): Add IOPARM_ptype_wait. (gfc_st_parameter): + Add "wait" entry. (iocall): Add IOCALL_WAIT enumerator. + (gfc_build_io_library_fndecls): Add function declaration for st_wait. + (gfc_trans_open): Add mask bits for new I/O tags. + (gfc_trans_inquire): Add mask bits for new I/O tags. + (gfc_trans_wait): New translation function. + (build_dt): Add mask bits for new I/O tags. + * match.c (gfc_match_if) Add matcher for "wait". + * match.h (gfc_match_wait): Prototype for new function. + * ioparm.def: Add new I/O parameter definitions. + * parse.c (decode_statement): Add match for "wait" statement. + (next_statement): Add case for ST_WAIT. (gfc_ascii_statement): Same. + + 2008-04-03 Jakub Jelinek + + PR fortran/35786 + * openmp.c (resolve_omp_clauses): Diagnose if a clause symbol + isn't a variable. + + 2008-04-03 Tom Tromey + + * Make-lang.in (fortran_OBJS): New variable. + + 2008-04-03 Paolo Bonzini + + * f95-lang.c (insert_block): Kill. + + 2008-04-01 George Helffrich + + PR fortran/35154, fortran/23057 + * trans-common.c (create_common): Add decl to function + chain to preserve identifier scope in debug output. + + 2008-04-01 Joseph Myers + + * gfortran.texi: Include gpl_v3.texi instead of gpl.texi + * Make-lang.in (GFORTRAN_TEXI): Include gpl_v3.texi instead of + gpl.texi. + + 2008-03-30 Paul Thomas + + PR fortran/35740 + * resolve.c (resolve_function, resolve_call): If the procedure + is elemental do not look for noncopying intrinsics. + + 2008-03-29 Paul Thomas + + PR fortran/35698 + * trans-array.c (gfc_array_init_size): Set 'size' zero if + negative in one dimension. + + PR fortran/35702 + * trans-expr.c (gfc_trans_string_copy): Only assign a char + directly if the lhs and rhs types are the same. + + 2008-03-28 Daniel Franke + Paul Richard Thomas + + PR fortran/34714 + * primary.c (match_variable): Improved matching of function + result variables. + * resolve.c (resolve_allocate_deallocate): Removed checks if + the actual argument for STAT is a variable. + + 2008-03-28 Tobias Burnus + + * symbol.c (gfc_get_default_type): Fix error message; option + -fallow_leading_underscore should be -fallow-leading-underscore + + 2008-03-27 Jerry DeLisle + + PR fortran/35724 + * iresolve.c (gfc_resolve_cshift): Check for NULL symtree in test for + optional argument attribute. + + 2008-03-27 Tom Tromey + + * Make-lang.in: Revert automatic dependency patch. + + 2008-03-25 Tom Tromey + + * Make-lang.in: Remove .o targets. + (fortran_OBJS): New variable. + (fortran/gfortranspec.o): Move to fortran/. Reduce to variable + setting. + (GFORTRAN_D_OBJS): Update. + (GFORTRAN_TRANS_DEPS): Remove. + + 2008-03-24 Paul Thomas + + PR fortran/34813 + * resolve.c (resolve_structure_cons): It is an error to assign + NULL to anything other than a pointer or allocatable component. + + PR fortran/33295 + * resolve.c (resolve_symbol): If the symbol is a derived type, + resolve the derived type. If the symbol is a derived type + function, ensure that the derived type is visible in the same + namespace as the function. + + 2008-03-23 Tobias Schlüter + + * trans.h: Use fold_build in build1_v, build2_v and build3_v + macros. + * trans-openmp.c (gfc_trans_omp_critical, gfc_trans_omp_single): + Don't use build2_v macro. + + 2008-03-19 Daniel Franke + + PR fortran/35152 + * interface.c (gfc_procedure_use): Check for keyworded arguments in + procedures without explicit interfaces. + + 2008-03-16 Paul Thomas + + PR fortran/35470 + * resolve.c (check_assumed_size_reference): Only visit the + first reference and look directly at the highest dimension. + + 2008-03-15 Jerry DeLisle + + PR fortran/35184 + * trans-array.c (gfc_conv_array_index_offset): Remove unnecessary + assert. + + 2008-03-15 Daniel Franke + + PR fortran/35584 + * resolve.c (resolve_branch): Less strict and pessimistic warning + message. + + 2008-03-11 Paolo Bonzini + + * f95-lang.c (LANG_HOOKS_CLEAR_BINDING_STACK): Delete. + (gfc_be_parse_file): Call clear_binding_stack from here. + (gfc_clear_binding_stack): Rename to clear_binding_stack. + + 2008-03-09 Paul Thomas + + PR fortran/35474 + * module.c (mio_symtree_ref): After providing a symbol for a + missing equivalence member, resolve and NULL the fixups. + + 2008-03-09 Ralf Wildenhues + + * invoke.texi (Error and Warning Options): Document + -Wline-truncation. + + 2008-03-08 Francois-Xavier Coudert + + PR fortran/34956 + * trans-array.c (gfc_conv_ss_startstride): Fix the logic to avoid + checking bounds of absent optional arguments. + + 2008-03-06 Francois-Xavier Coudert + + PR fortran/33197 + * intrinsic.c (add_functions): Add simplification routines for + ERF, DERF, ERFC and DERFC. + * decl.c (gfc_match_suffix, gfc_match_subroutine): Change GNU + extensions into Fortran 2008 features. + * intrinsic.h (gfc_simplify_erf, gfc_simplify_erfc): New + prototypes. + * simplify.c (gfc_simplify_erf, gfc_simplify_erfc): New functions. + + 2008-03-03 Francois-Xavier Coudert + + PR fortran/33197 + * intrinsic.c (add_functions): Modify intrinsics ACOSH, ASINH, + ATANH, ERF, ERFC and GAMMA. Add intrinsics BESSEL_{J,Y}{0,1,N}, + ERFC_SCALED, LOG_GAMMA and HYPOT. + * intrinsic.h (gfc_check_hypot, gfc_simplify_hypot, + gfc_resolve_hypot): New prototypes. + * mathbuiltins.def: Add HYPOT builtin. Make complex versions of + ACOSH, ASINH and ATANH available. + * gfortran.h (GFC_ISYM_ERFC_SCALED, GFC_ISYM_HYPOT): New values. + * lang.opt: Add -std=f2008 option. + * libgfortran.h: Define GFC_STD_F2008. + * lang-specs.h: Add .f08 and .F08 file suffixes. + * iresolve.c (gfc_resolve_hypot): New function. + * parse.c (parse_contained): Allow empty CONTAINS for Fortran 2008. + * check.c (gfc_check_hypot): New function. + * trans-intrinsic.c (gfc_intrinsic_map): Define ERFC_SCALE builtin. + * options.c (set_default_std_flags): Allow Fortran 2008 by default. + (form_from_filename): Add .f08 suffix. + (gfc_handle_option): Handle -std=f2008 option. + * simplify.c (gfc_simplify_hypot): New function. + * gfortran.texi: Document Fortran 2008 status and file extensions. + * intrinsic.texi: Document new BESSEL_{J,Y}{0,1,N} intrinsics, + as well as HYPOT and ERFC_SCALED. Update documentation of ERF, + ERFC, GAMMA, LGAMMA, ASINH, ACOSH and ATANH. + * invoke.texi: Document the new -std=f2008 option. + + 2008-03-02 Jakub Jelinek + + * gfortranspec.c (lang_specific_driver): Update copyright notice + dates. + + 2008-02-29 Jerry DeLisle + + PR fortran/35059 + * expr.c (find_array_element): Modify traversing the constructor to + avoid trying to access NULL memory pointed to by next for the + last element. (find_array_section): Exit while loop if cons->next is + NULL. + * trans-expr.c (gfc_conv_scalar_char_value): Initialize gfc_typespec. + (gfc_conv_function_call): Same. + * decl.c (gfc_match_implicit): Same. + * trans-intrinsic.c (gfc_conv_intrinsic_sr_kind): Same. + + 2008-02-28 Daniel Franke + + PR fortran/31463 + PR fortran/33950 + PR fortran/34296 + * lang.opt: Added -Wreturn-type. + * options.c (gfc_handle_option): Recognize -Wreturn-type. + * trans-decl.c (gfc_trans_deferred_vars): Emit warnings for funtions + where the result value is not set. + (gfc_generate_function_code): Likewise. + (generate_local_decl): Emit warnings for funtions whose RESULT + variable is not set. + + 2008-02-28 Francois-Xavier Coudert + + PR fortran/34868 + * trans-expr.c (gfc_conv_variable): Don't build indirect + references when explicit interface is mandated. + * resolve.c (resolve_formal_arglist): Set attr.always_explicit + on the result symbol as well as the procedure symbol. + + 2008-02-27 Francois-Xavier Coudert + + PR fortran/33387 + * trans.h: Remove prototypes for gfor_fndecl_math_exponent4, + gfor_fndecl_math_exponent8, gfor_fndecl_math_exponent10 and + gfor_fndecl_math_exponent16. + * f95-lang.c (build_builtin_fntypes): Add new function types. + (gfc_init_builtin_functions): Add new builtins for nextafter, + frexp, ldexp, fabs, scalbn and inf. + * iresolve.c (gfc_resolve_rrspacing): Don't add hidden arguments. + (gfc_resolve_scale): Don't convert type of second argument. + (gfc_resolve_set_exponent): Likewise. + (gfc_resolve_size): Don't add hidden arguments. + * trans-decl.c: Remove gfor_fndecl_math_exponent4, + gfor_fndecl_math_exponent8, gfor_fndecl_math_exponent10 and + gfor_fndecl_math_exponent16. + * trans-intrinsic.c (gfc_intrinsic_map): Remove intrinsics + for scalbn, fraction, nearest, rrspacing, set_exponent and + spacing. + (gfc_conv_intrinsic_exponent): Directly call frexp. + (gfc_conv_intrinsic_fraction, gfc_conv_intrinsic_nearest, + gfc_conv_intrinsic_spacing, gfc_conv_intrinsic_rrspacing, + gfc_conv_intrinsic_scale, gfc_conv_intrinsic_set_exponent): New + functions. + (gfc_conv_intrinsic_function): Use the new functions above. + + 2008-02-26 Tobias Burnus + + PR fortran/35033 + * interface.c (check_operator_interface): Show better line for error + messages; fix constrains for user-defined assignment operators. + (gfc_extend_assign): Fix constrains for user-defined assignment + operators. + + 2008-02-26 Tom Tromey + + * trans-io.c (set_error_locus): Remove old location code. + * trans-decl.c (gfc_set_decl_location): Remove old location code. + * f95-lang.c (gfc_init): Remove test of USE_MAPPED_LOCATION. + * scanner.c (gfc_gobble_whitespace): Remove old location code. + (get_file): Likewise. + (preprocessor_line): Likewise. + (load_file): Likewise. + (gfc_new_file): Likewise. + * trans.c (gfc_trans_runtime_check): Remove old location code. + (gfc_get_backend_locus): Likewise. + (gfc_set_backend_locus): Likewise. + * data.c (gfc_assign_data_value): Remove old location code. + * error.c (show_locus): Remove old location code. + * gfortran.h (gfc_linebuf): Remove old location code. + (gfc_linebuf_linenum): Remove old-location variant. + + 2008-02-25 Francois-Xavier Coudert + + PR fortran/34729 + * trans-const.c (gfc_build_string_const): Don't call gettext. + (gfc_build_localized_string_const): New function. + * trans-const.h (gfc_build_localized_string_const): New prototype. + * trans.c (gfc_trans_runtime_check): Use + gfc_build_localized_string_const instead of gfc_build_string_const. + (gfc_call_malloc): Likewise. + (gfc_allocate_with_status): Likewise. + (gfc_allocate_array_with_status): Likewise. + (gfc_deallocate_with_status): Likewise. + (gfc_call_realloc): Likewise. + * trans-io.c (gfc_trans_io_runtime_check): Likewise. + + 2008-02-24 Tobias Schlüter + + * arith.c: Update copyright years. + * arith.h: Likewise. + * array.c: Likewise. + * bbt.c: Likewise. + * check.c: Likewise. + * data.c: Likewise. + * data.h: Likewise. + * decl.c: Likewise. + * dependency.c: Likewise. + * dependency.h: Likewise. + * dump-parse-tree.c: Likewise. + * error.c: Likewise. + * expr.c: Likewise. + * gfc-internals.texi: Likewise. + * gfortran.h: Likewise. + * gfortran.texi: Likewise. + * gfortranspec.c: Likewise. + * interface.c: Likewise. + * intrinsic.c: Likewise. + * intrinsic.h: Likewise. + * intrinsic.texi: Likewise. + * invoke.texi: Likewise. + * io.c: Likewise. + * iresolve.c: Likewise. + * iso-c-binding.def: Likewise. + * iso-fortran-env.def: Likewise. + * lang-specs.h: Likewise. + * lang.opt: Likewise. + * libgfortran.h: Likewise. + * match.c: Likewise. + * match.h: Likewise. + * matchexp.c: Likewise. + * misc.c: Likewise. + * module.c: Likewise. + * openmp.c: Likewise. + * options.c: Likewise. + * parse.c: Likewise. + * parse.h: Likewise. + * primary.c: Likewise. + * resolve.c: Likewise. + * scanner.c: Likewise. + * simplify.c: Likewise. + * st.c: Likewise. + * symbol.c: Likewise. + * target-memory.c: Likewise. + * target-memory.h: Likewise. + * trans-array.h: Likewise. + * trans-const.h: Likewise. + * trans-stmt.h: Likewise. + * trans-types.c: Likewise. + * trans-types.h: Likewise. + * types.def: Likewise. + + 2008-02-24 Jerry DeLisle + + PR fortran/35223 + * simplify.c (gfc_simplify_ibclr), (gfc_simplify_ibits), + (gfc_simplify_ibset): Remove call to range_check. + (simplify_cmplx), (gfc_simplify_dble), (gfc_simplify_float) + (gfc_simplify_real): Add call gfc_clear_ts to initialize the + temporary gfc_typspec variable. + + 2008-02-24 Tobias Schlüter + + * trans-array.c (gfc_conv_descriptor_data_get, + gfc_conv_descriptor_data_set_internal, + gfc_conv_descriptor_data_addr, gfc_conv_descriptor_offset, + gfc_conv_descriptor_dtype, gfc_conv_descriptor_dimension, + gfc_conv_descriptor_stride, gfc_conv_descriptor_lbound, + gfc_conv_descriptor_ubound, gfc_trans_create_temp_array, + gfc_conv_array_transpose, gfc_grow_array, + gfc_trans_array_constructor_subarray, + gfc_trans_array_constructor_value, gfc_trans_scalarized_loop_end, + gfc_array_init_size, gfc_array_allocate, gfc_array_deallocate, + gfc_conv_array_initializer, gfc_trans_array_bounds, + gfc_trans_auto_array_allocation, gfc_trans_dummy_array_bias, + gfc_get_dataptr_offset, gfc_conv_array_parameter, + gfc_trans_dealloc_allocated, get_full_array_size, + gfc_duplicate_allocatable, structure_alloc_comps): Use fold_buildN + instead of buildN. + * trans-expr.c (gfc_conv_expr_present, gfc_conv_missing_dummy, + gfc_conv_component_ref, gfc_conv_cst_int_power, + gfc_conv_function_call, gfc_trans_structur_assign): Likewise. + * trans-common.c (create_common): Likewise. + * trans-openmp.c (gfc_trans_omp_atomic, gfc_trans_omp_do): + Likewise. + * trans-const.c (gfc_conv_constant_to_tree): Likewise. + * trans-stmt.c (gfc_trans_goto, gfc_trans_return, gfc_trans_do, + gfc_trans_integer_select, gfc_trans_character_select, + gfc_trans_forall_loop, compute_overall_iter_number, + gfc_trans_forall_1, gfc_evaluate_where_mask, gfc_trans_allocate, + gfc_trans_deallocate): Likewise. + * trans.c (gfc_build_addr_expr, gfc_trans_runtime_check, + gfc_allocate_with_status, gfc_allocate_array_with_status, + gfc_deallocate_with_status): Likewise. + * f95-lang.c (gfc_truthvalue_conversion): Likewise. + * trans-io.c (set_parameter_const, set_parameter_value, + set_parameter_ref, set_string, set_internal_unit, io_result, + set_error_locus, nml_get_addr_expr, transfer_expr): Likewise. + * trans-decl.c (gfc_build_qualified_array, build_entry_thunks, + gfc_get_fake_result_decl, gfc_trans_auto_character_variable, + gfc_generate_function_code): Likewise. + * convert.c (convert): Likewise. + * trans-intrinsic.c (gfc_conv_intrinsic_conversion, + build_fixbound_expr, build_fix_expr, gfc_conv_intrinsic_aint, + gfc_conv_intrinsic_int, gfc_conv_intrinsic_imagpart, + gfc_conv_intrinsic_conjg, gfc_conv_intrinsic_abs, + gfc_conv_intrinsic_cmplx, gfc_conv_intrinsic_mod, + gfc_conv_intrinsic_dim, gfc_conv_intrinsic_dprod, + gfc_conv_intrinsic_ctime, gfc_conv_intrinsic_fdate, + gfc_conv_intrinsic_ttynam, gfc_conv_intrinsic_minmax, + gfc_conv_intrinsic_minmax_char, gfc_conv_intrinsic_count, + gfc_conv_intrinsic_arith, gfc_conv_intrinsic_dot_product, + gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_minmaxval, + gfc_conv_intrinsic_btest, gfc_conv_intrinsic_not, + gfc_conv_intrinsic_ibits, gfc_conv_intrinsic_ishft, + gfc_conv_intrinsic_ichar, gfc_conv_intrinsic_size, + gfc_conv_intrinsic_array_transfer, gfc_conv_intrinsic_transfer, + gfc_conv_allocated, gfc_conv_associated, gfc_conv_intrinsic_trim, + gfc_conv_intrinsic_repeat): Likewise. + + 2008-02-23 Francois-Xavier Coudert + + PR target/25477 + * trans-expr.c (gfc_conv_power_op): Use BUILT_IN_CPOW{F,,L}. + * f95-lang.c (gfc_init_builtin_functions): Define BUILT_IN_CPOW{F,,L}. + * trans.h (gfor_fndecl_math_cpow, gfor_fndecl_math_cpowf, + gfor_fndecl_math_cpowl10, gfor_fndecl_math_cpowl16): Remove. + * trans-decl.c: Likewise. + + 2008-02-22 Jerry DeLisle + + PR fortran/35059 + * expr.c (find_array_element): Modify traversing the constructor to + avoid trying to access NULL memory pointed to by next for the + last element. (find_array_section): Exit while loop if cons->next is + NULL. + + 2008-02-22 Jerry DeLisle + + PR fortran/34907 + * iresolve.c (resolve_mask_arg): Add gfc_clear_ts to initialize + structure. + (gfc_resolve_aint): Likewise. + (gfc_resolve_anint): Likewise. + (gfc_resolve_besn): Likewise. + (gfc_resolve_cshift): Likewise. + (gfc_resolve_ctime): Likewise. + (gfc_resolve_eoshift): Likewise. + (gfc_resolve_index_func): Likewise. + (gfc_resolve_isatty): Likewise. + (gfc_resolve_malloc): Likewise. + (gfc_resolve_rrspacing): Likewise. + (gfc_resolve_scale): Likewise. + (gfc_resolve_set_exponent): Likewise. + (gfc_resolve_spacing): Likewise. + (gfc_resolve_spacing): Likewise. + (gfc_resolve_fgetc): Likewise. + (gfc_resolve_fputc): Likewise. + (gfc_resolve_ftell): Likewise. + (gfc_resolve_ttynam): Likewise. + (gfc_resolve_alarm_sub): Likewise. + (gfc_resolve_mvbits): Likewise. + (gfc_resolve_getarg): Likewise. + (gfc_resolve_signal_sub): Likewise. + (gfc_resolve_exit): Likewise. + (gfc_resolve_flush): Likewise. + (gfc_resolve_free): Likewise. + (gfc_resolve_ctime_sub): Likewise. + (gfc_resolve_fgetc_sub): Likewise. + (gfc_resolve_fputc_sub): Likewise. + (gfc_resolve_fseek_sub): Likewise. + (gfc_resolve_ftell_sub): Likewise. + (gfc_resolve_ttynam_sub): Likewise. + + 2008-02-22 Ralf Wildenhues + + * gfc-internals.texi: Fix typos and markup nits. + * gfortran.texi: Likewise. + * intrinsic.texi: Likewise. + + 2008-02-21 Richard Guenther + + * trans-expr.c (gfc_conv_expr_op): Expand INTRINSIC_PARENTHESES + as unary PAREN_EXPR for real and complex typed expressions. + (gfc_conv_unary_op): Fold the built tree. + + 2008-02-20 Tobias Burnus + + PR fortran/34997 + * match.c (gfc_match_name): Improve error message for '$'. + + 2008-02-19 Daniel Franke + + PR fortran/35030 + * expr.c (gfc_check_pointer_assign): Add type and kind information + to type-mismatch message. + (gfc_check_assign): Unify error messages. + + 2008-02-16 Francois-Xavier Coudert + + PR fortran/34952 + * gfortran.texi: Create new section for unimplemented extensions. + Add "STRUCTURE and RECORD" and "ENCODE and DECODE statements". + Remove "smaller projects" list. Fix a few typos. + + 2008-02-15 Francois-Xavier Coudert + + * intrinsic.texi: Rename INDEX node to avoid clashing with + index.html on case-insensitive systems. + + 2008-02-15 Francois-Xavier Coudert + + PR fortran/35150 + * trans-expr.c (gfc_conv_function_call): Force evaluation of + se->expr. + + 2008-02-10 Daniel Franke + + PR fortran/35019 + * lang.opt: Allow '-J' next to '-J ', + likewise '-I ' and '-I'. + + 2008-02-06 Kaveh R. Ghazi + + PR other/35107 + * Make-lang.in (f951): Add $(GMPLIBS). + + 2008-02-05 Francois-Xavier Coudert + + PR fortran/35037 + * trans-common.c (build_field): Mark fields as volatile when needed. + + 2008-02-05 Tobias Burnus + + PR fortran/35093 + * data.c (gfc_assign_data_value): Only free "size" if + it has not already been freed. + + 2008-02-05 Paul Thomas + + PR fortran/34945 + * array.c (match_array_element_spec): Remove check for negative + array size. + (gfc_resolve_array_spec): Add check for negative size. + + 2008-02-05 Paul Thomas + + PR fortran/32315 + * data.c (gfc_assign_data_value): Add bounds check for array + references. + + 2008-02-04 Daniel Franke + + * resolve.c (resolve_where): Fix typo. + (gfc_resolve_where_code_in_forall): Likewise. + + 2008-02-03 Paul Thomas + + PR fortran/32760 + * resolve.c (resolve_allocate_deallocate): New function. + (resolve_code): Call it for allocate and deallocate. + * match.c (gfc_match_allocate, gfc_match_deallocate) : Remove + the checking of the STAT tag and put in above new function. + * primary,c (match_variable): Do not fix flavor of host + associated symbols yet if the type is not known. + + 2008-01-31 Paul Thomas + + PR fortran/34910 + * expr.c (gfc_check_assign): It is an error to assign + to a sibling procedure. + + 2008-01-30 Paul Thomas + + PR fortran/34975 + * symbol.c (gfc_delete_symtree, gfc_undo_symbols): Rename + delete_symtree to gfc_delete_symtree. + * gfortran.h : Add prototype for gfc_delete_symtree. + * module.c (load_generic_interfaces): Transfer symbol to a + unique symtree and delete old symtree, instead of renaming. + (read_module): The rsym and the found symbol are the same, so + the found symtree can be deleted. + + PR fortran/34429 + * decl.c (match_char_spec): Remove the constraint on deferred + matching of functions and free the length expression. + delete_symtree to gfc_delete_symtree. + (gfc_match_type_spec): Whitespace. + (gfc_match_function_decl): Defer characteristic association for + all types except BT_UNKNOWN. + * parse.c (decode_specification_statement): Only derived type + function matching is delayed to the end of specification. + + 2008-01-28 Tobias Burnus + + PR libfortran/34980 + * simplify.c (gfc_simplify_shape): Simplify rank zero arrays. + + 2008-01-27 Jerry DeLisle + + PR fortran/34990 + * array.c (gfc_check_constructor_type): Revert clearing the expression. + + 2008-01-26 Tobias Burnus + + PR fortran/34848 + * trans-expr.c (gfc_conv_function_call): Don't call + gfc_add_interface_mapping if the expression is NULL. + + 2008-01-26 Jerry DeLisle + + PR fortran/31610 + * trans-array.c (gfc_trans_create_temp_array): Remove call to + gcc_assert (integer_zerop (loop->from[n])). + + 2008-01-25 Daniel Franke + + PR fortran/34661 + * resolve.c (resolve_where): Added check if user-defined assignment + operator is an elemental subroutine. + (gfc_resolve_where_code_in_forall): Likewise. + + 2008-01-24 Daniel Franke + + PR fortran/33375 + PR fortran/34858 + * gfortran.h: Revert changes from 2008-01-17. + * match.c: Likewise. + * symbol.c: Likewise. + (gfc_undo_symbols): Undo namespace changes related to common blocks. + + 2008-01-24 Daniel Franke + + PR fortran/34202 + * data.c (formalize_structure_cons): Skip formalization on + empty structures. + + 2008-01-24 Daniel Franke + + * gfortran.texi (OpenMP): Extended existing documentation. + (contributors): Added major contributors of 2008 that were + not listed yet. + (proposed extensions): Removed implemented items. + + 2008-01-24 Paul Thomas + + PR fortran/34872 + * parse.c (next_statement) : If ST_GET_FCN_CHARACTERISTICS is + seen, check for a statement label and, if present, delete it + and set the locus to the start of the statement. + + 2008-01-22 Paul Thomas + + PR fortran/34875 + * trans-io.c (gfc_trans_transfer): If the array reference in a + read has a vector subscript, use gfc_conv_subref_array_arg to + copy back the temporary. + + 2008-01-22 Tobias Burnus + + PR fortran/34848 + * interface.c (compare_actual_formal): Fix adding type + to missing_arg_type for absent optional arguments. + + 2008-01-22 Tobias Burnus + + PR fortran/34907 + * parse.c (parse_spec): Change = into ==. + + 2008-01-22 Daniel Franke + + PR fortran/34915 + * expr.c (check_elemental): Fix check for valid data types. + + 2008-01-22 Tobias Burnus + + PR fortran/34899 + * scanner.c (load_line): Support continuation lines. + * invoke.texi (-Wtabs): Document this. + + 2008-01-22 Paul Thomas + + PR fortran/34896 + * module.c (read_module): Set use_rename attribute. + + 2007-01-21 Tobias Burnus + + PR fortran/34901 + * interface.c (compare_parameter): Improved error message + for arguments of same type and mismatched kinds. + + 2008-01-20 Paul Thomas + + PR fortran/34861 + * resolve.c (resolve_entries): Do not do an array bounds check + if the result symbols are the same. + + PR fortran/34854 + * module.c (read_module) : Hide the symtree of the previous + version of the symbol if this symbol is renamed. + + 2008-01-20 Paul Thomas + + PR fortran/34784 + * array.c (gfc_check_constructor_type): Clear the expression ts + so that the checking starts from the deepest level of array + constructor. + * primary.c (match_varspec): If an unknown type is changed to + default character and the attempt to match a substring fails, + change it back to unknown. + + PR fortran/34785 + * trans-array.c (gfc_add_loop_ss_code) : If ss->string_length is + NULL for an array constructor, use the cl.length expression to + build it. + (gfc_conv_array_parameter): Change call to gfc_evaluate_now to + a tree assignment. + + 2008-01-19 Thomas Koenig + + PR fortran/34817 + PR fortran/34838 + * iresolve.c (gfc_resolve_all): Remove conversion of mask + argument to kind=1 by removing call to resolve_mask_arg(). + (gfc_resolve_any): Likewise. + + 2008-01-19 Tobias Burnus + + PR fortran/34760 + * primary.c (match_variable): Handle FL_UNKNOWN without + uneducated guessing. + (match_variable): Improve error message. + + 2008-01-18 Tobias Burnus + + PR fortran/32616 + * interface.c (get_expr_storage_size): Return storage size + for array element designators. + (compare_actual_formal): Reject unequal string sizes for + assumed-shape dummy arguments. And fix error message for + array-sections with vector subscripts. + + 2008-01-17 Jerry DeLisle + + PR fortran/34556 + * simplify.c (is_constant_array_expr): New static function that returns + true if the given expression is an array and is constant. + (gfc_simplify_reshape): Use new function. + + 2008-01-17 H.J. Lu + + PR fortran/33375 + * symbol.c (free_common_tree): Renamed to ... + (gfc_free_common_tree): This. Remove static. + (gfc_free_namespace): Updated. + + * gfortran.h (gfc_free_common_tree): New. + + * match.c (gfc_match_common): Call gfc_free_common_tree () with + gfc_current_ns->common_root and set gfc_current_ns->common_root + to NULL on syntax error. + + 2008-01-18 Richard Sandiford + + PR fortran/34686 + * trans-expr.c (gfc_conv_function_call): Use proper + type for returned character pointers. + + 2008-01-17 Paul Thomas + + PR fortran/34429 + PR fortran/34431 + PR fortran/34471 + * decl.c : Remove gfc_function_kind_locus and + gfc_function_type_locus. Add gfc_matching_function. + (match_char_length): If matching a function and the length + does not match, return MATCH_YES and try again later. + (gfc_match_kind_spec): The same. + (match_char_kind): The same. + (gfc_match_type_spec): The same for numeric and derived types. + (match_prefix): Rename as gfc_match_prefix. + (gfc_match_function_decl): Except for function valued character + lengths, defer applying kind, type and charlen info until the + end of specification block. + gfortran.h (gfc_statement): Add ST_GET_FCN_CHARACTERISTICS. + parse.c (decode_specification_statement): New function. + (decode_statement): Call it when a function has kind = -1. Set + and reset gfc_matching function, as function statement is being + matched. + (match_deferred_characteristics): Simplify with a single call + to gfc_match_prefix. Do appropriate error handling. In any + case, make sure that kind = -1 is reset or corrected. + (parse_spec): Call above on seeing ST_GET_FCN_CHARACTERISTICS. + Throw an error if kind = -1 after last specification statement. + parse.h : Prototype for gfc_match_prefix. + + 2008-01-16 Tobias Burnus + + PR fortran/34796 + * interface.c (compare_parameter): Allow AS_DEFERRED array + elements and reject attr.pointer array elemenents. + (get_expr_storage_size): Return storage size of elements of + assumed-shape and pointer arrays. + + 2008-01-15 Sebastian Pop + + * f95-lang.c (gfc_init_builtin_functions): Initialize GOMP builtins + for flag_tree_parallelize_loops. + + 2008-01-15 Thomas Koenig + + PR libfortran/34671 + * iresolve.c (gfc_resolve_all): Call resolve_mask_arg. + (gfc_resolve_any): Likewise. + (gfc_resolve_count): Likewise. Don't append kind of + argument to function name. + + 2008-01-13 Tobias Burnus + + PR fortran/34665 + * resolve.c (resolve_actual_arglist): For expressions, + also check for assume-sized arrays. + * interface.c (compare_parameter): Move F2003 character checks + here, print error messages here, reject elements of + assumed-shape array as argument to dummy arrays. + (compare_actual_formal): Update for the changes above. + + 2008-01-13 Tobias Burnus + + PR fortran/34763 + * decl.c (contained_procedure): Only check directly preceeding state. + + 2008-01-13 Tobias Burnus + + PR fortran/34759 + * check.c (gfc_check_shape): Accept array ranges of + assumed-size arrays. + + 2008-01-12 Jerry DeLisle + + PR fortran/34432 + * match.c (gfc_match_name): Don't error if leading character is a '(', + just return MATCH_NO. + + 2008-01-11 Jerry DeLisle + + PR fortran/34722 + * trans-io.c (create_dummy_iostat): Commit the symbol. + + 2008-01-11 Paul Thomas + + PR fortran/34537 + * simplify.c (gfc_simplify_transfer): Return NULL if the size + of the element is unavailable and only assign character length + to the result, if 'mold' is constant. + + 2008-01-10 Paul Thomas + + PR fortran/34396 + * trans-array.c (gfc_trans_array_ctor_element): Use gfc_trans_string_copy + to assign strings and perform bounds checks on the string length. + (get_array_ctor_strlen): Remove bounds checking. + (gfc_trans_array_constructor): Initialize string length checking. + * trans-array.h : Add prototype for gfc_trans_string_copy. + + 2008-01-08 Richard Guenther + + PR fortran/34706 + PR tree-optimization/34683 + * trans-types.c (gfc_get_array_type_bounds): Use an array type + with known size for accesses if that is known. + + 2008-01-08 Paul Thomas + + PR fortran/34476 + * expr.c (find_array_element): Check that the array bounds are + constant before using them. Use lower, as well as upper bound. + (check_restricted): Allow implied index variable. + + 2008-01-08 Paul Thomas + + PR fortran/34681 + * trans_array.c (gfc_trans_deferred_array): Do not null the + data pointer on entering scope, nor deallocate it on leaving + scope, if the symbol has the 'save' attribute. + + PR fortran/34704 + * trans_decl.c (gfc_finish_var_decl): Derived types with + allocatable components and an initializer must be TREE_STATIC. + + 2008-01-07 Paul Thomas + + PR fortran/34672 + * module.c (write_generic): Rewrite completely. + (write_module): Change call to write_generic. + + 2008-01-06 Jerry DeLisle + + PR fortran/34659 + * scanner.c (load_line): Do not count ' ' as printable when checking for + continuations. + + 2008-01-06 Paul Thomas + + PR fortran/34545 + * module.c (load_needed): If the namespace has no proc_name + give it the module symbol. + + 2008-01-06 Jerry DeLisle + + PR fortran/34387 + * trans-expr.c (gfc_conv_missing_dummy): Use a temporary to type convert + the dummy variable expression, test for NULL, and pass the variable + address to the called function. + + 2007-01-06 Tobias Burnus + + PR fortran/34658 + * match.c (gfc_match_common): Remove blank common in + DATA BLOCK warning. + * resolve.c (resolve_common_vars): New function. + (resolve_common_blocks): Move checks to resolve_common_vars + and invoke that function. + (resolve_types): Call resolve_common_vars for blank commons. + + 2008-01-06 Tobias Burnus + + PR fortran/34655 + * resolve.c (resolve_equivalence_derived): Reject derived types with + default initialization if equivalenced with COMMON variable. + + 2008-01-06 Tobias Burnus + + PR fortran/34654 + * io.c (check_io_constraints): Disallow unformatted I/O for + internal units. + + 2008-01-06 Tobias Burnus + + PR fortran/34660 + * resolve.c (resolve_formal_arglist): Reject dummy procedure in + ELEMENTAL functions. + + 2008-01-06 Tobias Burnus + + PR fortran/34662 + * interface.c (compare_actual_formal): Reject parameter + actual to intent(out) dummy. + + 2008-01-04 Tobias Burnus + + PR fortran/34557 + * primary.c (match_varspec): Gobble whitespace before + checking for '('. diff -Nrcpad gcc-4.3.3/gcc/fortran/Make-lang.in gcc-4.4.0/gcc/fortran/Make-lang.in *** gcc-4.3.3/gcc/fortran/Make-lang.in Thu Dec 4 23:00:19 2008 --- gcc-4.4.0/gcc/fortran/Make-lang.in Thu Dec 11 11:29:38 2008 *************** *** 1,6 **** # -*- makefile -*- # Top level makefile fragment for GNU gfortran, the GNU Fortran 95 compiler. ! # Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. # Contributed by Paul Brook --- 1,7 ---- # -*- makefile -*- # Top level makefile fragment for GNU gfortran, the GNU Fortran 95 compiler. ! # Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software ! # Foundation, Inc. # Contributed by Paul Brook *************** fortran-warn = $(STRICT_WARN) *** 52,72 **** # from the parse tree to GENERIC F95_PARSER_OBJS = fortran/arith.o fortran/array.o fortran/bbt.o \ ! fortran/check.o fortran/data.o fortran/decl.o fortran/dump-parse-tree.o \ ! fortran/error.o fortran/expr.o fortran/interface.o \ ! fortran/intrinsic.o fortran/io.o fortran/iresolve.o \ fortran/match.o fortran/matchexp.o fortran/misc.o fortran/module.o \ fortran/openmp.o fortran/options.o fortran/parse.o fortran/primary.o \ fortran/resolve.o fortran/scanner.o fortran/simplify.o fortran/st.o \ fortran/symbol.o fortran/target-memory.o ! F95_OBJS = $(F95_PARSER_OBJS) \ fortran/convert.o fortran/dependency.o fortran/f95-lang.o \ fortran/trans.o fortran/trans-array.o fortran/trans-common.o \ fortran/trans-const.o fortran/trans-decl.o fortran/trans-expr.o \ fortran/trans-intrinsic.o fortran/trans-io.o fortran/trans-openmp.o \ fortran/trans-stmt.o fortran/trans-types.o # # Define the names for selecting gfortran in LANGUAGES. fortran: f951$(exeext) --- 53,75 ---- # from the parse tree to GENERIC F95_PARSER_OBJS = fortran/arith.o fortran/array.o fortran/bbt.o \ ! fortran/check.o fortran/cpp.o fortran/data.o fortran/decl.o \ ! fortran/dump-parse-tree.o fortran/error.o fortran/expr.o \ ! fortran/interface.o fortran/intrinsic.o fortran/io.o fortran/iresolve.o \ fortran/match.o fortran/matchexp.o fortran/misc.o fortran/module.o \ fortran/openmp.o fortran/options.o fortran/parse.o fortran/primary.o \ fortran/resolve.o fortran/scanner.o fortran/simplify.o fortran/st.o \ fortran/symbol.o fortran/target-memory.o ! F95_OBJS = $(F95_PARSER_OBJS) $(FORTRAN_TARGET_OBJS) \ fortran/convert.o fortran/dependency.o fortran/f95-lang.o \ fortran/trans.o fortran/trans-array.o fortran/trans-common.o \ fortran/trans-const.o fortran/trans-decl.o fortran/trans-expr.o \ fortran/trans-intrinsic.o fortran/trans-io.o fortran/trans-openmp.o \ fortran/trans-stmt.o fortran/trans-types.o + fortran_OBJS = $(F95_OBJS) gfortranspec.o + # # Define the names for selecting gfortran in LANGUAGES. fortran: f951$(exeext) *************** fortran: f951$(exeext) *** 74,80 **** # Tell GNU make to ignore files by these names if they exist. .PHONY: fortran ! gfortranspec.o: $(srcdir)/fortran/gfortranspec.c $(SYSTEM_H) $(TM_H) $(GCC_H) $(CONFIG_H) (SHLIB_LINK='$(SHLIB_LINK)'; \ $(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(DRIVER_DEFINES) \ $(INCLUDES) $(srcdir)/fortran/gfortranspec.c) --- 77,84 ---- # Tell GNU make to ignore files by these names if they exist. .PHONY: fortran ! gfortranspec.o: $(srcdir)/fortran/gfortranspec.c $(SYSTEM_H) $(TM_H) $(GCC_H) \ ! $(CONFIG_H) coretypes.h intl.h (SHLIB_LINK='$(SHLIB_LINK)'; \ $(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(DRIVER_DEFINES) \ $(INCLUDES) $(srcdir)/fortran/gfortranspec.c) *************** gfortran-cross$(exeext): gfortran$(exeex *** 94,100 **** f951$(exeext): $(F95_OBJS) \ $(BACKEND) $(LIBDEPS) attribs.o $(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ \ ! $(F95_OBJS) $(BACKEND) $(LIBS) attribs.o $(GMPLIBS) gt-fortran-trans.h : s-gtype; @true # --- 98,104 ---- f951$(exeext): $(F95_OBJS) \ $(BACKEND) $(LIBDEPS) attribs.o $(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ \ ! $(F95_OBJS) $(BACKEND) $(LIBS) attribs.o $(BACKENDLIBS) gt-fortran-trans.h : s-gtype; @true # *************** doc/gfc-internals.pdf: $(GFC_INTERNALS_T *** 207,215 **** # Create or recreate the gfortran private include file directory. install-finclude-dir: installdirs ! -rm -rf $(DESTDIR)$(libsubdir)/finclude ! mkdir $(DESTDIR)$(libsubdir)/finclude ! -chmod a+rx $(DESTDIR)$(libsubdir)/finclude # # Install hooks: # f951 is installed elsewhere as part of $(COMPILERS). --- 211,217 ---- # Create or recreate the gfortran private include file directory. install-finclude-dir: installdirs ! $(mkinstalldirs) -m 0755 $(DESTDIR)$(libsubdir)/finclude # # Install hooks: # f951 is installed elsewhere as part of $(COMPILERS). *************** GFORTRAN_TRANS_DEPS = fortran/gfortran.h *** 310,323 **** $(CONFIG_H) $(SYSTEM_H) $(TREE_H) $(TM_H) coretypes.h $(GGC_H) fortran/f95-lang.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \ ! gt-fortran-f95-lang.h gtype-fortran.h $(CGRAPH_H) $(TARGET_H) \ $(BUILTINS_DEF) fortran/types.def ! fortran/scanner.o: toplev.h fortran/convert.o: $(GFORTRAN_TRANS_DEPS) ! fortran/trans.o: $(GFORTRAN_TRANS_DEPS) fortran/trans-decl.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-decl.h \ ! $(CGRAPH_H) $(TARGET_H) $(FUNCTION_H) $(FLAGS_H) $(RTL_H) $(TREE_GIMPLE_H) \ ! $(TREE_DUMP_H) fortran/trans-types.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-types.h \ $(REAL_H) toplev.h $(TARGET_H) $(FLAGS_H) dwarf2out.h fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS) --- 312,325 ---- $(CONFIG_H) $(SYSTEM_H) $(TREE_H) $(TM_H) coretypes.h $(GGC_H) fortran/f95-lang.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \ ! gt-fortran-f95-lang.h gtype-fortran.h $(CGRAPH_H) $(TARGET_H) fortran/cpp.h \ $(BUILTINS_DEF) fortran/types.def ! fortran/scanner.o: toplev.h fortran/cpp.h fortran/convert.o: $(GFORTRAN_TRANS_DEPS) ! fortran/trans.o: $(GFORTRAN_TRANS_DEPS) tree-iterator.h fortran/trans-decl.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-decl.h \ ! $(CGRAPH_H) $(TARGET_H) $(FUNCTION_H) $(FLAGS_H) $(RTL_H) $(GIMPLE_H) \ ! $(TREE_DUMP_H) debug.h fortran/trans-types.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-types.h \ $(REAL_H) toplev.h $(TARGET_H) $(FLAGS_H) dwarf2out.h fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS) *************** fortran/dependency.o: $(GFORTRAN_TRANS_D *** 333,336 **** fortran/trans-common.o: $(GFORTRAN_TRANS_DEPS) $(TARGET_H) $(RTL_H) fortran/resolve.o: fortran/dependency.h fortran/data.h fortran/target-memory.h fortran/data.o: fortran/data.h ! fortran/options.o: $(PARAMS_H) $(TARGET_H) --- 335,341 ---- fortran/trans-common.o: $(GFORTRAN_TRANS_DEPS) $(TARGET_H) $(RTL_H) fortran/resolve.o: fortran/dependency.h fortran/data.h fortran/target-memory.h fortran/data.o: fortran/data.h ! fortran/options.o: $(PARAMS_H) $(TARGET_H) fortran/cpp.h ! fortran/cpp.o: fortran/cpp.c $(BASEVER) incpath.h incpath.o ! $(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) -DBASEVER=$(BASEVER_s) \ ! $< $(OUTPUT_OPTION) diff -Nrcpad gcc-4.3.3/gcc/fortran/arith.c gcc-4.4.0/gcc/fortran/arith.c *** gcc-4.3.3/gcc/fortran/arith.c Fri Dec 14 15:11:17 2007 --- gcc-4.4.0/gcc/fortran/arith.c Tue Nov 25 05:55:55 2008 *************** *** 1,5 **** /* Compiler arithmetic ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Compiler arithmetic ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Andy Vaught *************** along with GCC; see the file COPYING3. *** 35,49 **** It's easily implemented with a few calls though. */ void ! gfc_mpfr_to_mpz (mpz_t z, mpfr_t x) { mp_exp_t e; e = mpfr_get_z_exp (z, x); - /* MPFR 2.0.1 (included with GMP 4.1) has a bug whereby mpfr_get_z_exp - may set the sign of z incorrectly. Work around that here. */ - if (mpfr_sgn (x) != mpz_sgn (z)) - mpz_neg (z, z); if (e > 0) mpz_mul_2exp (z, z, e); --- 35,53 ---- It's easily implemented with a few calls though. */ void ! gfc_mpfr_to_mpz (mpz_t z, mpfr_t x, locus *where) { mp_exp_t e; + if (mpfr_inf_p (x) || mpfr_nan_p (x)) + { + gfc_error ("Conversion of an Infinity or Not-a-Number at %L " + "to INTEGER", where); + mpz_set_ui (z, 0); + return; + } + e = mpfr_get_z_exp (z, x); if (e > 0) mpz_mul_2exp (z, z, e); *************** gfc_arith_init_1 (void) *** 123,146 **** { gfc_integer_info *int_info; gfc_real_info *real_info; ! mpfr_t a, b, c; ! mpz_t r; int i; mpfr_set_default_prec (128); mpfr_init (a); - mpz_init (r); /* Convert the minimum and maximum values for each kind into their GNU MP representation. */ for (int_info = gfc_integer_kinds; int_info->kind != 0; int_info++) { /* Huge */ - mpz_set_ui (r, int_info->radix); - mpz_pow_ui (r, r, int_info->digits); - mpz_init (int_info->huge); ! mpz_sub_ui (int_info->huge, r, 1); /* These are the numbers that are actually representable by the target. For bases other than two, this needs to be changed. */ --- 127,147 ---- { gfc_integer_info *int_info; gfc_real_info *real_info; ! mpfr_t a, b; int i; mpfr_set_default_prec (128); mpfr_init (a); /* Convert the minimum and maximum values for each kind into their GNU MP representation. */ for (int_info = gfc_integer_kinds; int_info->kind != 0; int_info++) { /* Huge */ mpz_init (int_info->huge); ! mpz_set_ui (int_info->huge, int_info->radix); ! mpz_pow_ui (int_info->huge, int_info->huge, int_info->digits); ! mpz_sub_ui (int_info->huge, int_info->huge, 1); /* These are the numbers that are actually representable by the target. For bases other than two, this needs to be changed. */ *************** gfc_arith_init_1 (void) *** 164,171 **** mpfr_set_z (a, int_info->huge, GFC_RND_MODE); mpfr_log10 (a, a, GFC_RND_MODE); mpfr_trunc (a, a); ! gfc_mpfr_to_mpz (r, a); ! int_info->range = mpz_get_si (r); } mpfr_clear (a); --- 165,171 ---- mpfr_set_z (a, int_info->huge, GFC_RND_MODE); mpfr_log10 (a, a, GFC_RND_MODE); mpfr_trunc (a, a); ! int_info->range = (int) mpfr_get_si (a, GFC_RND_MODE); } mpfr_clear (a); *************** gfc_arith_init_1 (void) *** 176,224 **** mpfr_init (a); mpfr_init (b); - mpfr_init (c); /* huge(x) = (1 - b**(-p)) * b**(emax-1) * b */ ! /* a = 1 - b**(-p) */ ! mpfr_set_ui (a, 1, GFC_RND_MODE); ! mpfr_set_ui (b, real_info->radix, GFC_RND_MODE); ! mpfr_pow_si (b, b, -real_info->digits, GFC_RND_MODE); ! mpfr_sub (a, a, b, GFC_RND_MODE); ! ! /* c = b**(emax-1) */ ! mpfr_set_ui (b, real_info->radix, GFC_RND_MODE); ! mpfr_pow_ui (c, b, real_info->max_exponent - 1, GFC_RND_MODE); ! /* a = a * c = (1 - b**(-p)) * b**(emax-1) */ ! mpfr_mul (a, a, c, GFC_RND_MODE); ! /* a = (1 - b**(-p)) * b**(emax-1) * b */ ! mpfr_mul_ui (a, a, real_info->radix, GFC_RND_MODE); ! mpfr_init (real_info->huge); ! mpfr_set (real_info->huge, a, GFC_RND_MODE); /* tiny(x) = b**(emin-1) */ - mpfr_set_ui (b, real_info->radix, GFC_RND_MODE); - mpfr_pow_si (b, b, real_info->min_exponent - 1, GFC_RND_MODE); - mpfr_init (real_info->tiny); ! mpfr_set (real_info->tiny, b, GFC_RND_MODE); /* subnormal (x) = b**(emin - digit) */ - mpfr_set_ui (b, real_info->radix, GFC_RND_MODE); - mpfr_pow_si (b, b, real_info->min_exponent - real_info->digits, - GFC_RND_MODE); - mpfr_init (real_info->subnormal); ! mpfr_set (real_info->subnormal, b, GFC_RND_MODE); /* epsilon(x) = b**(1-p) */ - mpfr_set_ui (b, real_info->radix, GFC_RND_MODE); - mpfr_pow_si (b, b, 1 - real_info->digits, GFC_RND_MODE); - mpfr_init (real_info->epsilon); ! mpfr_set (real_info->epsilon, b, GFC_RND_MODE); /* range(x) = int(min(log10(huge(x)), -log10(tiny)) */ mpfr_log10 (a, real_info->huge, GFC_RND_MODE); --- 176,218 ---- mpfr_init (a); mpfr_init (b); /* huge(x) = (1 - b**(-p)) * b**(emax-1) * b */ ! /* 1 - b**(-p) */ ! mpfr_init (real_info->huge); ! mpfr_set_ui (real_info->huge, 1, GFC_RND_MODE); ! mpfr_set_ui (a, real_info->radix, GFC_RND_MODE); ! mpfr_pow_si (a, a, -real_info->digits, GFC_RND_MODE); ! mpfr_sub (real_info->huge, real_info->huge, a, GFC_RND_MODE); ! /* b**(emax-1) */ ! mpfr_set_ui (a, real_info->radix, GFC_RND_MODE); ! mpfr_pow_ui (a, a, real_info->max_exponent - 1, GFC_RND_MODE); ! /* (1 - b**(-p)) * b**(emax-1) */ ! mpfr_mul (real_info->huge, real_info->huge, a, GFC_RND_MODE); ! /* (1 - b**(-p)) * b**(emax-1) * b */ ! mpfr_mul_ui (real_info->huge, real_info->huge, real_info->radix, ! GFC_RND_MODE); /* tiny(x) = b**(emin-1) */ mpfr_init (real_info->tiny); ! mpfr_set_ui (real_info->tiny, real_info->radix, GFC_RND_MODE); ! mpfr_pow_si (real_info->tiny, real_info->tiny, ! real_info->min_exponent - 1, GFC_RND_MODE); /* subnormal (x) = b**(emin - digit) */ mpfr_init (real_info->subnormal); ! mpfr_set_ui (real_info->subnormal, real_info->radix, GFC_RND_MODE); ! mpfr_pow_si (real_info->subnormal, real_info->subnormal, ! real_info->min_exponent - real_info->digits, GFC_RND_MODE); /* epsilon(x) = b**(1-p) */ mpfr_init (real_info->epsilon); ! mpfr_set_ui (real_info->epsilon, real_info->radix, GFC_RND_MODE); ! mpfr_pow_si (real_info->epsilon, real_info->epsilon, ! 1 - real_info->digits, GFC_RND_MODE); /* range(x) = int(min(log10(huge(x)), -log10(tiny)) */ mpfr_log10 (a, real_info->huge, GFC_RND_MODE); *************** gfc_arith_init_1 (void) *** 227,257 **** /* a = min(a, b) */ mpfr_min (a, a, b, GFC_RND_MODE); - mpfr_trunc (a, a); ! gfc_mpfr_to_mpz (r, a); ! real_info->range = mpz_get_si (r); /* precision(x) = int((p - 1) * log10(b)) + k */ mpfr_set_ui (a, real_info->radix, GFC_RND_MODE); mpfr_log10 (a, a, GFC_RND_MODE); - mpfr_mul_ui (a, a, real_info->digits - 1, GFC_RND_MODE); mpfr_trunc (a, a); ! gfc_mpfr_to_mpz (r, a); ! real_info->precision = mpz_get_si (r); /* If the radix is an integral power of 10, add one to the precision. */ for (i = 10; i <= real_info->radix; i *= 10) if (i == real_info->radix) real_info->precision++; ! mpfr_clear (a); ! mpfr_clear (b); ! mpfr_clear (c); } - - mpz_clear (r); } --- 221,243 ---- /* a = min(a, b) */ mpfr_min (a, a, b, GFC_RND_MODE); mpfr_trunc (a, a); ! real_info->range = (int) mpfr_get_si (a, GFC_RND_MODE); /* precision(x) = int((p - 1) * log10(b)) + k */ mpfr_set_ui (a, real_info->radix, GFC_RND_MODE); mpfr_log10 (a, a, GFC_RND_MODE); mpfr_mul_ui (a, a, real_info->digits - 1, GFC_RND_MODE); mpfr_trunc (a, a); ! real_info->precision = (int) mpfr_get_si (a, GFC_RND_MODE); /* If the radix is an integral power of 10, add one to the precision. */ for (i = 10; i <= real_info->radix; i *= 10) if (i == real_info->radix) real_info->precision++; ! mpfr_clears (a, b, NULL); } } *************** gfc_arith_done_1 (void) *** 271,282 **** } for (rp = gfc_real_kinds; rp->kind; rp++) ! { ! mpfr_clear (rp->epsilon); ! mpfr_clear (rp->huge); ! mpfr_clear (rp->tiny); ! mpfr_clear (rp->subnormal); ! } } --- 257,280 ---- } for (rp = gfc_real_kinds; rp->kind; rp++) ! mpfr_clears (rp->epsilon, rp->huge, rp->tiny, rp->subnormal, NULL); ! } ! ! ! /* Given a wide character value and a character kind, determine whether ! the character is representable for that kind. */ ! bool ! gfc_check_character_range (gfc_char_t c, int kind) ! { ! /* As wide characters are stored as 32-bit values, they're all ! representable in UCS=4. */ ! if (kind == 4) ! return true; ! ! if (kind == 1) ! return c <= 255 ? true : false; ! ! gcc_unreachable (); } *************** gfc_check_real_range (mpfr_t p, int kind *** 328,356 **** mpfr_init (q); mpfr_abs (q, p, GFC_RND_MODE); if (mpfr_inf_p (p)) { ! if (gfc_option.flag_range_check == 0) ! retval = ARITH_OK; ! else retval = ARITH_OVERFLOW; } else if (mpfr_nan_p (p)) { ! if (gfc_option.flag_range_check == 0) ! retval = ARITH_OK; ! else retval = ARITH_NAN; } else if (mpfr_sgn (q) == 0) ! retval = ARITH_OK; else if (mpfr_cmp (q, gfc_real_kinds[i].huge) > 0) { if (gfc_option.flag_range_check == 0) ! { ! mpfr_set_inf (p, mpfr_sgn (p)); ! retval = ARITH_OK; ! } else retval = ARITH_OVERFLOW; } --- 326,352 ---- mpfr_init (q); mpfr_abs (q, p, GFC_RND_MODE); + retval = ARITH_OK; + if (mpfr_inf_p (p)) { ! if (gfc_option.flag_range_check != 0) retval = ARITH_OVERFLOW; } else if (mpfr_nan_p (p)) { ! if (gfc_option.flag_range_check != 0) retval = ARITH_NAN; } else if (mpfr_sgn (q) == 0) ! { ! mpfr_clear (q); ! return retval; ! } else if (mpfr_cmp (q, gfc_real_kinds[i].huge) > 0) { if (gfc_option.flag_range_check == 0) ! mpfr_set_inf (p, mpfr_sgn (p)); else retval = ARITH_OVERFLOW; } *************** gfc_check_real_range (mpfr_t p, int kind *** 366,372 **** } else mpfr_set_ui (p, 0, GFC_RND_MODE); - retval = ARITH_OK; } else retval = ARITH_UNDERFLOW; --- 362,367 ---- *************** gfc_check_real_range (mpfr_t p, int kind *** 384,389 **** --- 379,385 ---- en = gfc_real_kinds[i].min_exponent - gfc_real_kinds[i].digits + 1; mpfr_set_emin ((mp_exp_t) en); mpfr_set_emax ((mp_exp_t) gfc_real_kinds[i].max_exponent); + mpfr_check_range (q, 0, GFC_RND_MODE); mpfr_subnormalize (q, 0, GFC_RND_MODE); /* Reset emin and emax. */ *************** gfc_check_real_range (mpfr_t p, int kind *** 395,405 **** mpfr_neg (p, q, GMP_RNDN); else mpfr_set (p, q, GMP_RNDN); - - retval = ARITH_OK; } - else - retval = ARITH_OK; mpfr_clear (q); --- 391,397 ---- *************** gfc_arith_times (gfc_expr *op1, gfc_expr *** 762,769 **** mpfr_mul (y, op1->value.complex.i, op2->value.complex.r, GFC_RND_MODE); mpfr_add (result->value.complex.i, x, y, GFC_RND_MODE); ! mpfr_clear (x); ! mpfr_clear (y); break; default: --- 754,760 ---- mpfr_mul (y, op1->value.complex.i, op2->value.complex.r, GFC_RND_MODE); mpfr_add (result->value.complex.i, x, y, GFC_RND_MODE); ! mpfr_clears (x, y, NULL); break; default: *************** gfc_arith_divide (gfc_expr *op1, gfc_exp *** 841,849 **** mpfr_div (result->value.complex.i, result->value.complex.i, div, GFC_RND_MODE); ! mpfr_clear (x); ! mpfr_clear (y); ! mpfr_clear (div); break; default: --- 832,838 ---- mpfr_div (result->value.complex.i, result->value.complex.i, div, GFC_RND_MODE); ! mpfr_clears (x, y, div, NULL); break; default: *************** gfc_arith_divide (gfc_expr *op1, gfc_exp *** 862,891 **** static void complex_reciprocal (gfc_expr *op) { ! mpfr_t mod, a, re, im; gfc_set_model (op->value.complex.r); mpfr_init (mod); ! mpfr_init (a); ! mpfr_init (re); ! mpfr_init (im); mpfr_mul (mod, op->value.complex.r, op->value.complex.r, GFC_RND_MODE); ! mpfr_mul (a, op->value.complex.i, op->value.complex.i, GFC_RND_MODE); ! mpfr_add (mod, mod, a, GFC_RND_MODE); ! ! mpfr_div (re, op->value.complex.r, mod, GFC_RND_MODE); ! mpfr_neg (im, op->value.complex.i, GFC_RND_MODE); ! mpfr_div (im, im, mod, GFC_RND_MODE); ! mpfr_set (op->value.complex.r, re, GFC_RND_MODE); ! mpfr_set (op->value.complex.i, im, GFC_RND_MODE); ! mpfr_clear (re); ! mpfr_clear (im); ! mpfr_clear (mod); ! mpfr_clear (a); } --- 851,872 ---- static void complex_reciprocal (gfc_expr *op) { ! mpfr_t mod, tmp; gfc_set_model (op->value.complex.r); mpfr_init (mod); ! mpfr_init (tmp); mpfr_mul (mod, op->value.complex.r, op->value.complex.r, GFC_RND_MODE); ! mpfr_mul (tmp, op->value.complex.i, op->value.complex.i, GFC_RND_MODE); ! mpfr_add (mod, mod, tmp, GFC_RND_MODE); ! mpfr_div (op->value.complex.r, op->value.complex.r, mod, GFC_RND_MODE); ! mpfr_neg (op->value.complex.i, op->value.complex.i, GFC_RND_MODE); ! mpfr_div (op->value.complex.i, op->value.complex.i, mod, GFC_RND_MODE); ! mpfr_clears (tmp, mod, NULL); } *************** complex_pow (gfc_expr *result, gfc_expr *** 917,924 **** mpfr_set (x_r, base->value.complex.r, GFC_RND_MODE); mpfr_set (x_i, base->value.complex.i, GFC_RND_MODE); ! /* Macro for complex multiplication. We have to take care that ! res_r/res_i and a_r/a_i can (and will) be the same variable. */ #define CMULT(res_r,res_i,a_r,a_i,b_r,b_i) \ mpfr_mul (re, a_r, b_r, GFC_RND_MODE), \ mpfr_mul (tmp, a_i, b_i, GFC_RND_MODE), \ --- 898,905 ---- mpfr_set (x_r, base->value.complex.r, GFC_RND_MODE); mpfr_set (x_i, base->value.complex.i, GFC_RND_MODE); ! /* Macro for complex multiplication. We have to take care that ! res_r/res_i and a_r/a_i can (and will) be the same variable. */ #define CMULT(res_r,res_i,a_r,a_i,b_r,b_i) \ mpfr_mul (re, a_r, b_r, GFC_RND_MODE), \ mpfr_mul (tmp, a_i, b_i, GFC_RND_MODE), \ *************** complex_pow (gfc_expr *result, gfc_expr *** 947,957 **** #undef res_i #undef CMULT ! mpfr_clear (x_r); ! mpfr_clear (x_i); ! mpfr_clear (tmp); ! mpfr_clear (re); ! mpfr_clear (im); } --- 928,934 ---- #undef res_i #undef CMULT ! mpfr_clears (x_r, x_i, tmp, re, im, NULL); } *************** gfc_arith_concat (gfc_expr *op1, gfc_exp *** 1097,1115 **** gfc_expr *result; int len; ! result = gfc_constant_result (BT_CHARACTER, gfc_default_character_kind, &op1->where); len = op1->value.character.length + op2->value.character.length; ! result->value.character.string = gfc_getmem (len + 1); result->value.character.length = len; memcpy (result->value.character.string, op1->value.character.string, ! op1->value.character.length); ! memcpy (result->value.character.string + op1->value.character.length, ! op2->value.character.string, op2->value.character.length); result->value.character.string[len] = '\0'; --- 1074,1094 ---- gfc_expr *result; int len; ! gcc_assert (op1->ts.kind == op2->ts.kind); ! result = gfc_constant_result (BT_CHARACTER, op1->ts.kind, &op1->where); len = op1->value.character.length + op2->value.character.length; ! result->value.character.string = gfc_get_wide_string (len + 1); result->value.character.length = len; memcpy (result->value.character.string, op1->value.character.string, ! op1->value.character.length * sizeof (gfc_char_t)); ! memcpy (&result->value.character.string[op1->value.character.length], ! op2->value.character.string, ! op2->value.character.length * sizeof (gfc_char_t)); result->value.character.string[len] = '\0'; *************** gfc_arith_concat (gfc_expr *op1, gfc_exp *** 1119,1125 **** } /* Comparison between real values; returns 0 if (op1 .op. op2) is true. ! This function mimics mpr_cmp but takes NaN into account. */ static int compare_real (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op) --- 1098,1104 ---- } /* Comparison between real values; returns 0 if (op1 .op. op2) is true. ! This function mimics mpfr_cmp but takes NaN into account. */ static int compare_real (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op) *************** gfc_compare_expr (gfc_expr *op1, gfc_exp *** 1186,1192 **** /* Compare a pair of complex numbers. Naturally, this is only for ! equality and nonequality. */ static int compare_complex (gfc_expr *op1, gfc_expr *op2) --- 1165,1171 ---- /* Compare a pair of complex numbers. Naturally, this is only for ! equality and inequality. */ static int compare_complex (gfc_expr *op1, gfc_expr *op2) *************** compare_complex (gfc_expr *op1, gfc_expr *** 1203,1221 **** int gfc_compare_string (gfc_expr *a, gfc_expr *b) { ! int len, alen, blen, i, ac, bc; alen = a->value.character.length; blen = b->value.character.length; ! len = (alen > blen) ? alen : blen; for (i = 0; i < len; i++) { ! /* We cast to unsigned char because default char, if it is signed, ! would lead to ac < 0 for string[i] > 127. */ ! ac = (unsigned char) ((i < alen) ? a->value.character.string[i] : ' '); ! bc = (unsigned char) ((i < blen) ? b->value.character.string[i] : ' '); if (ac < bc) return -1; --- 1182,1199 ---- int gfc_compare_string (gfc_expr *a, gfc_expr *b) { ! int len, alen, blen, i; ! gfc_char_t ac, bc; alen = a->value.character.length; blen = b->value.character.length; ! len = MAX(alen, blen); for (i = 0; i < len; i++) { ! ac = ((i < alen) ? a->value.character.string[i] : ' '); ! bc = ((i < blen) ? b->value.character.string[i] : ' '); if (ac < bc) return -1; *************** gfc_compare_string (gfc_expr *a, gfc_exp *** 1224,1230 **** --- 1202,1240 ---- } /* Strings are equal */ + return 0; + } + + int + gfc_compare_with_Cstring (gfc_expr *a, const char *b, bool case_sensitive) + { + int len, alen, blen, i; + gfc_char_t ac, bc; + + alen = a->value.character.length; + blen = strlen (b); + + len = MAX(alen, blen); + + for (i = 0; i < len; i++) + { + ac = ((i < alen) ? a->value.character.string[i] : ' '); + bc = ((i < blen) ? b[i] : ' '); + + if (!case_sensitive) + { + ac = TOLOWER (ac); + bc = TOLOWER (bc); + } + + if (ac < bc) + return -1; + if (ac > bc) + return 1; + } + + /* Strings are equal */ return 0; } *************** eval_f; *** 1548,1554 **** operands are array constructors. */ static gfc_expr * ! eval_intrinsic (gfc_intrinsic_op operator, eval_f eval, gfc_expr *op1, gfc_expr *op2) { gfc_expr temp, *result; --- 1558,1564 ---- operands are array constructors. */ static gfc_expr * ! eval_intrinsic (gfc_intrinsic_op op, eval_f eval, gfc_expr *op1, gfc_expr *op2) { gfc_expr temp, *result; *************** eval_intrinsic (gfc_intrinsic_op operato *** 1557,1563 **** gfc_clear_ts (&temp.ts); ! switch (operator) { /* Logical unary */ case INTRINSIC_NOT: --- 1567,1573 ---- gfc_clear_ts (&temp.ts); ! switch (op) { /* Logical unary */ case INTRINSIC_NOT: *************** eval_intrinsic (gfc_intrinsic_op operato *** 1623,1628 **** --- 1633,1643 ---- unary = 0; temp.ts.type = BT_LOGICAL; temp.ts.kind = gfc_default_logical_kind; + + /* If kind mismatch, exit and we'll error out later. */ + if (op1->ts.kind != op2->ts.kind) + goto runtime; + break; } *************** eval_intrinsic (gfc_intrinsic_op operato *** 1641,1659 **** temp.expr_type = EXPR_OP; gfc_clear_ts (&temp.ts); ! temp.value.op.operator = operator; temp.value.op.op1 = op1; temp.value.op.op2 = op2; gfc_type_convert_binary (&temp); ! if (operator == INTRINSIC_EQ || operator == INTRINSIC_NE ! || operator == INTRINSIC_GE || operator == INTRINSIC_GT ! || operator == INTRINSIC_LE || operator == INTRINSIC_LT ! || operator == INTRINSIC_EQ_OS || operator == INTRINSIC_NE_OS ! || operator == INTRINSIC_GE_OS || operator == INTRINSIC_GT_OS ! || operator == INTRINSIC_LE_OS || operator == INTRINSIC_LT_OS) { temp.ts.type = BT_LOGICAL; temp.ts.kind = gfc_default_logical_kind; --- 1656,1674 ---- temp.expr_type = EXPR_OP; gfc_clear_ts (&temp.ts); ! temp.value.op.op = op; temp.value.op.op1 = op1; temp.value.op.op2 = op2; gfc_type_convert_binary (&temp); ! if (op == INTRINSIC_EQ || op == INTRINSIC_NE ! || op == INTRINSIC_GE || op == INTRINSIC_GT ! || op == INTRINSIC_LE || op == INTRINSIC_LT ! || op == INTRINSIC_EQ_OS || op == INTRINSIC_NE_OS ! || op == INTRINSIC_GE_OS || op == INTRINSIC_GT_OS ! || op == INTRINSIC_LE_OS || op == INTRINSIC_LT_OS) { temp.ts.type = BT_LOGICAL; temp.ts.kind = gfc_default_logical_kind; *************** eval_intrinsic (gfc_intrinsic_op operato *** 1664,1674 **** /* Character binary */ case INTRINSIC_CONCAT: ! if (op1->ts.type != BT_CHARACTER || op2->ts.type != BT_CHARACTER) goto runtime; temp.ts.type = BT_CHARACTER; ! temp.ts.kind = gfc_default_character_kind; unary = 0; break; --- 1679,1690 ---- /* Character binary */ case INTRINSIC_CONCAT: ! if (op1->ts.type != BT_CHARACTER || op2->ts.type != BT_CHARACTER ! || op1->ts.kind != op2->ts.kind) goto runtime; temp.ts.type = BT_CHARACTER; ! temp.ts.kind = op1->ts.kind; unary = 0; break; *************** eval_intrinsic (gfc_intrinsic_op operato *** 1680,1686 **** } /* Try to combine the operators. */ ! if (operator == INTRINSIC_POWER && op2->ts.type != BT_INTEGER) goto runtime; if (op1->expr_type != EXPR_CONSTANT --- 1696,1702 ---- } /* Try to combine the operators. */ ! if (op == INTRINSIC_POWER && op2->ts.type != BT_INTEGER) goto runtime; if (op1->expr_type != EXPR_CONSTANT *************** runtime: *** 1715,1721 **** result->ts = temp.ts; result->expr_type = EXPR_OP; ! result->value.op.operator = operator; result->value.op.op1 = op1; result->value.op.op2 = op2; --- 1731,1737 ---- result->ts = temp.ts; result->expr_type = EXPR_OP; ! result->value.op.op = op; result->value.op.op1 = op1; result->value.op.op2 = op2; *************** runtime: *** 1729,1740 **** /* Modify type of expression for zero size array. */ static gfc_expr * ! eval_type_intrinsic0 (gfc_intrinsic_op operator, gfc_expr *op) { if (op == NULL) gfc_internal_error ("eval_type_intrinsic0(): op NULL"); ! switch (operator) { case INTRINSIC_GE: case INTRINSIC_GE_OS: --- 1745,1756 ---- /* Modify type of expression for zero size array. */ static gfc_expr * ! eval_type_intrinsic0 (gfc_intrinsic_op iop, gfc_expr *op) { if (op == NULL) gfc_internal_error ("eval_type_intrinsic0(): op NULL"); ! switch (iop) { case INTRINSIC_GE: case INTRINSIC_GE_OS: *************** reduce_binary0 (gfc_expr *op1, gfc_expr *** 1796,1802 **** static gfc_expr * ! eval_intrinsic_f2 (gfc_intrinsic_op operator, arith (*eval) (gfc_expr *, gfc_expr **), gfc_expr *op1, gfc_expr *op2) { --- 1812,1818 ---- static gfc_expr * ! eval_intrinsic_f2 (gfc_intrinsic_op op, arith (*eval) (gfc_expr *, gfc_expr **), gfc_expr *op1, gfc_expr *op2) { *************** eval_intrinsic_f2 (gfc_intrinsic_op oper *** 1806,1827 **** if (op2 == NULL) { if (gfc_zero_size_array (op1)) ! return eval_type_intrinsic0 (operator, op1); } else { result = reduce_binary0 (op1, op2); if (result != NULL) ! return eval_type_intrinsic0 (operator, result); } f.f2 = eval; ! return eval_intrinsic (operator, f, op1, op2); } static gfc_expr * ! eval_intrinsic_f3 (gfc_intrinsic_op operator, arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), gfc_expr *op1, gfc_expr *op2) { --- 1822,1843 ---- if (op2 == NULL) { if (gfc_zero_size_array (op1)) ! return eval_type_intrinsic0 (op, op1); } else { result = reduce_binary0 (op1, op2); if (result != NULL) ! return eval_type_intrinsic0 (op, result); } f.f2 = eval; ! return eval_intrinsic (op, f, op1, op2); } static gfc_expr * ! eval_intrinsic_f3 (gfc_intrinsic_op op, arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), gfc_expr *op1, gfc_expr *op2) { *************** eval_intrinsic_f3 (gfc_intrinsic_op oper *** 1830,1839 **** result = reduce_binary0 (op1, op2); if (result != NULL) ! return eval_type_intrinsic0(operator, result); f.f3 = eval; ! return eval_intrinsic (operator, f, op1, op2); } --- 1846,1855 ---- result = reduce_binary0 (op1, op2); if (result != NULL) ! return eval_type_intrinsic0(op, result); f.f3 = eval; ! return eval_intrinsic (op, f, op1, op2); } *************** arith_error (arith rc, gfc_typespec *fro *** 2050,2060 **** gfc_typename (from), gfc_typename (to), where); break; case ARITH_UNDERFLOW: ! gfc_error ("Arithmetic underflow converting %s to %s at %L", gfc_typename (from), gfc_typename (to), where); break; case ARITH_NAN: ! gfc_error ("Arithmetic NaN converting %s to %s at %L", gfc_typename (from), gfc_typename (to), where); break; case ARITH_DIV0: --- 2066,2078 ---- gfc_typename (from), gfc_typename (to), where); break; case ARITH_UNDERFLOW: ! gfc_error ("Arithmetic underflow converting %s to %s at %L. This check " ! "can be disabled with the option -fno-range-check", gfc_typename (from), gfc_typename (to), where); break; case ARITH_NAN: ! gfc_error ("Arithmetic NaN converting %s to %s at %L. This check " ! "can be disabled with the option -fno-range-check", gfc_typename (from), gfc_typename (to), where); break; case ARITH_DIV0: *************** arith_error (arith rc, gfc_typespec *fro *** 2074,2080 **** gfc_internal_error ("gfc_arith_error(): Bad error code"); } ! /* TODO: Do something about the error, ie, throw exception, return NaN, etc. */ } --- 2092,2098 ---- gfc_internal_error ("gfc_arith_error(): Bad error code"); } ! /* TODO: Do something about the error, i.e., throw exception, return NaN, etc. */ } *************** gfc_real2int (gfc_expr *src, int kind) *** 2166,2172 **** result = gfc_constant_result (BT_INTEGER, kind, &src->where); ! gfc_mpfr_to_mpz (result->value.integer, src->value.real); if ((rc = gfc_check_integer_range (result->value.integer, kind)) != ARITH_OK) { --- 2184,2190 ---- result = gfc_constant_result (BT_INTEGER, kind, &src->where); ! gfc_mpfr_to_mpz (result->value.integer, src->value.real, &src->where); if ((rc = gfc_check_integer_range (result->value.integer, kind)) != ARITH_OK) { *************** gfc_complex2int (gfc_expr *src, int kind *** 2252,2258 **** result = gfc_constant_result (BT_INTEGER, kind, &src->where); ! gfc_mpfr_to_mpz (result->value.integer, src->value.complex.r); if ((rc = gfc_check_integer_range (result->value.integer, kind)) != ARITH_OK) { --- 2270,2276 ---- result = gfc_constant_result (BT_INTEGER, kind, &src->where); ! gfc_mpfr_to_mpz (result->value.integer, src->value.complex.r, &src->where); if ((rc = gfc_check_integer_range (result->value.integer, kind)) != ARITH_OK) { *************** hollerith2representation (gfc_expr *resu *** 2403,2411 **** &src->where, gfc_typename(&result->ts)); } ! result->representation.string = gfc_getmem (result_len + 1); memcpy (result->representation.string, src->representation.string, ! MIN (result_len, src_len)); if (src_len < result_len) memset (&result->representation.string[src_len], ' ', result_len - src_len); --- 2421,2429 ---- &src->where, gfc_typename(&result->ts)); } ! result->representation.string = XCNEWVEC (char, result_len + 1); memcpy (result->representation.string, src->representation.string, ! MIN (result_len, src_len)); if (src_len < result_len) memset (&result->representation.string[src_len], ' ', result_len - src_len); *************** gfc_hollerith2int (gfc_expr *src, int ki *** 2429,2436 **** result->where = src->where; hollerith2representation (result, src); ! gfc_interpret_integer(kind, (unsigned char *) result->representation.string, ! result->representation.length, result->value.integer); return result; } --- 2447,2454 ---- result->where = src->where; hollerith2representation (result, src); ! gfc_interpret_integer (kind, (unsigned char *) result->representation.string, ! result->representation.length, result->value.integer); return result; } *************** gfc_hollerith2real (gfc_expr *src, int k *** 2453,2460 **** result->where = src->where; hollerith2representation (result, src); ! gfc_interpret_float(kind, (unsigned char *) result->representation.string, ! result->representation.length, result->value.real); return result; } --- 2471,2478 ---- result->where = src->where; hollerith2representation (result, src); ! gfc_interpret_float (kind, (unsigned char *) result->representation.string, ! result->representation.length, result->value.real); return result; } *************** gfc_hollerith2complex (gfc_expr *src, in *** 2477,2485 **** result->where = src->where; hollerith2representation (result, src); ! gfc_interpret_complex(kind, (unsigned char *) result->representation.string, ! result->representation.length, result->value.complex.r, ! result->value.complex.i); return result; } --- 2495,2503 ---- result->where = src->where; hollerith2representation (result, src); ! gfc_interpret_complex (kind, (unsigned char *) result->representation.string, ! result->representation.length, result->value.complex.r, ! result->value.complex.i); return result; } *************** gfc_hollerith2character (gfc_expr *src, *** 2496,2503 **** result->ts.type = BT_CHARACTER; result->ts.kind = kind; - result->value.character.string = result->representation.string; result->value.character.length = result->representation.length; return result; } --- 2514,2522 ---- result->ts.type = BT_CHARACTER; result->ts.kind = kind; result->value.character.length = result->representation.length; + result->value.character.string + = gfc_char_to_widechar (result->representation.string); return result; } *************** gfc_hollerith2logical (gfc_expr *src, in *** 2520,2527 **** result->where = src->where; hollerith2representation (result, src); ! gfc_interpret_logical(kind, (unsigned char *) result->representation.string, ! result->representation.length, &result->value.logical); return result; } --- 2539,2546 ---- result->where = src->where; hollerith2representation (result, src); ! gfc_interpret_logical (kind, (unsigned char *) result->representation.string, ! result->representation.length, &result->value.logical); return result; } diff -Nrcpad gcc-4.3.3/gcc/fortran/arith.h gcc-4.4.0/gcc/fortran/arith.h *** gcc-4.3.3/gcc/fortran/arith.h Wed Dec 5 13:42:32 2007 --- gcc-4.4.0/gcc/fortran/arith.h Fri Oct 31 04:45:28 2008 *************** *** 1,5 **** /* Compiler arithmetic header. ! Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Steven Bosscher --- 1,5 ---- /* Compiler arithmetic header. ! Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Steven Bosscher *************** along with GCC; see the file COPYING3. *** 27,33 **** /* MPFR also does not have the conversion of a mpfr_t to a mpz_t, so declare a function for this as well. */ ! void gfc_mpfr_to_mpz (mpz_t, mpfr_t); void gfc_set_model_kind (int); void gfc_set_model (mpfr_t); --- 27,33 ---- /* MPFR also does not have the conversion of a mpfr_t to a mpz_t, so declare a function for this as well. */ ! void gfc_mpfr_to_mpz (mpz_t, mpfr_t, locus *); void gfc_set_model_kind (int); void gfc_set_model (mpfr_t); *************** arith gfc_range_check (gfc_expr *); *** 40,45 **** --- 40,47 ---- int gfc_compare_expr (gfc_expr *, gfc_expr *, gfc_intrinsic_op); int gfc_compare_string (gfc_expr *, gfc_expr *); + int gfc_compare_with_Cstring (gfc_expr *, const char *, bool); + /* Constant folding for gfc_expr trees. */ gfc_expr *gfc_parentheses (gfc_expr * op); diff -Nrcpad gcc-4.3.3/gcc/fortran/array.c gcc-4.4.0/gcc/fortran/array.c *** gcc-4.3.3/gcc/fortran/array.c Tue Feb 5 13:33:35 2008 --- gcc-4.4.0/gcc/fortran/array.c Sat Feb 21 22:25:06 2009 *************** *** 1,5 **** /* Array things ! Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Array things ! Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Andy Vaught *************** along with GCC; see the file COPYING3. *** 24,36 **** #include "gfortran.h" #include "match.h" - /* This parameter is the size of the largest array constructor that we - will expand to an array constructor without iterators. - Constructors larger than this will remain in the iterator form. */ - - #define GFC_MAX_AC_EXPAND 65535 - - /**************** Array reference matching subroutines *****************/ /* Copy an array reference structure. */ --- 24,29 ---- *************** gfc_free_array_spec (gfc_array_spec *as) *** 208,214 **** /* Take an array bound, resolves the expression, that make up the shape and check associated constraints. */ ! static try resolve_array_bound (gfc_expr *e, int check_constant) { if (e == NULL) --- 201,207 ---- /* Take an array bound, resolves the expression, that make up the shape and check associated constraints. */ ! static gfc_try resolve_array_bound (gfc_expr *e, int check_constant) { if (e == NULL) *************** resolve_array_bound (gfc_expr *e, int ch *** 232,238 **** /* Takes an array specification, resolves the expressions that make up the shape and make sure everything is integral. */ ! try gfc_resolve_array_spec (gfc_array_spec *as, int check_constant) { gfc_expr *e; --- 225,231 ---- /* Takes an array specification, resolves the expressions that make up the shape and make sure everything is integral. */ ! gfc_try gfc_resolve_array_spec (gfc_array_spec *as, int check_constant) { gfc_expr *e; *************** match_array_element_spec (gfc_array_spec *** 314,319 **** --- 307,314 ---- gfc_error ("Expected expression in array specification at %C"); if (m != MATCH_YES) return AS_UNKNOWN; + if (gfc_expr_check_typed (*upper, gfc_current_ns, false) == FAILURE) + return AS_UNKNOWN; if (gfc_match_char (':') == MATCH_NO) { *************** match_array_element_spec (gfc_array_spec *** 332,337 **** --- 327,334 ---- return AS_UNKNOWN; if (m == MATCH_NO) return AS_ASSUMED_SHAPE; + if (gfc_expr_check_typed (*upper, gfc_current_ns, false) == FAILURE) + return AS_UNKNOWN; return AS_EXPLICIT; } *************** gfc_match_array_spec (gfc_array_spec **a *** 437,442 **** --- 434,445 ---- goto cleanup; } + if (as->rank >= 7 + && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Array " + "specification at %C with more than 7 dimensions") + == FAILURE) + goto cleanup; + as->rank++; } *************** cleanup: *** 463,469 **** have that array specification. The error locus is needed in case something goes wrong. On failure, the caller must free the spec. */ ! try gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc) { if (as == NULL) --- 466,472 ---- have that array specification. The error locus is needed in case something goes wrong. On failure, the caller must free the spec. */ ! gfc_try gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc) { if (as == NULL) *************** gfc_start_constructor (bt type, int kind *** 586,592 **** node onto the constructor. */ void ! gfc_append_constructor (gfc_expr *base, gfc_expr *new) { gfc_constructor *c; --- 589,595 ---- node onto the constructor. */ void ! gfc_append_constructor (gfc_expr *base, gfc_expr *new_expr) { gfc_constructor *c; *************** gfc_append_constructor (gfc_expr *base, *** 602,610 **** c = c->next; } ! c->expr = new; ! if (new->ts.type != base->ts.type || new->ts.kind != base->ts.kind) gfc_internal_error ("gfc_append_constructor(): New node has wrong kind"); } --- 605,613 ---- c = c->next; } ! c->expr = new_expr; ! if (new_expr->ts.type != base->ts.type || new_expr->ts.kind != base->ts.kind) gfc_internal_error ("gfc_append_constructor(): New node has wrong kind"); } *************** gfc_get_constructor (void) *** 672,678 **** { gfc_constructor *c; ! c = gfc_getmem (sizeof(gfc_constructor)); c->expr = NULL; c->iterator = NULL; c->next = NULL; --- 675,681 ---- { gfc_constructor *c; ! c = XCNEW (gfc_constructor); c->expr = NULL; c->iterator = NULL; c->next = NULL; *************** static match match_array_cons_element (g *** 749,755 **** static match match_array_list (gfc_constructor **result) { ! gfc_constructor *p, *head, *tail, *new; gfc_iterator iter; locus old_loc; gfc_expr *e; --- 752,758 ---- static match match_array_list (gfc_constructor **result) { ! gfc_constructor *p, *head, *tail, *new_cons; gfc_iterator iter; locus old_loc; gfc_expr *e; *************** match_array_list (gfc_constructor **resu *** 784,790 **** if (m == MATCH_ERROR) goto cleanup; ! m = match_array_cons_element (&new); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) --- 787,793 ---- if (m == MATCH_ERROR) goto cleanup; ! m = match_array_cons_element (&new_cons); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) *************** match_array_list (gfc_constructor **resu *** 795,802 **** goto cleanup; /* Could be a complex constant */ } ! tail->next = new; ! tail = new; if (gfc_match_char (',') != MATCH_YES) { --- 798,805 ---- goto cleanup; /* Could be a complex constant */ } ! tail->next = new_cons; ! tail = new_cons; if (gfc_match_char (',') != MATCH_YES) { *************** match_array_cons_element (gfc_constructo *** 875,885 **** match gfc_match_array_constructor (gfc_expr **result) { ! gfc_constructor *head, *tail, *new; gfc_expr *expr; locus where; match m; const char *end_delim; if (gfc_match (" (/") == MATCH_NO) { --- 878,890 ---- match gfc_match_array_constructor (gfc_expr **result) { ! gfc_constructor *head, *tail, *new_cons; gfc_expr *expr; + gfc_typespec ts; locus where; match m; const char *end_delim; + bool seen_ts; if (gfc_match (" (/") == MATCH_NO) { *************** gfc_match_array_constructor (gfc_expr ** *** 898,924 **** where = gfc_current_locus; head = tail = NULL; if (gfc_match (end_delim) == MATCH_YES) { ! gfc_error ("Empty array constructor at %C is not allowed"); ! goto cleanup; } for (;;) { ! m = match_array_cons_element (&new); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) goto syntax; if (head == NULL) ! head = new; else ! tail->next = new; ! tail = new; if (gfc_match_char (',') == MATCH_NO) break; --- 903,951 ---- where = gfc_current_locus; head = tail = NULL; + seen_ts = false; + + /* Try to match an optional "type-spec ::" */ + if (gfc_match_type_spec (&ts, 0) == MATCH_YES) + { + seen_ts = (gfc_match (" ::") == MATCH_YES); + + if (seen_ts) + { + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Array constructor " + "including type specification at %C") == FAILURE) + goto cleanup; + } + } + + if (! seen_ts) + gfc_current_locus = where; if (gfc_match (end_delim) == MATCH_YES) { ! if (seen_ts) ! goto done; ! else ! { ! gfc_error ("Empty array constructor at %C is not allowed"); ! goto cleanup; ! } } for (;;) { ! m = match_array_cons_element (&new_cons); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) goto syntax; if (head == NULL) ! head = new_cons; else ! tail->next = new_cons; ! tail = new_cons; if (gfc_match_char (',') == MATCH_NO) break; *************** gfc_match_array_constructor (gfc_expr ** *** 927,932 **** --- 954,960 ---- if (gfc_match (end_delim) == MATCH_NO) goto syntax; + done: expr = gfc_get_expr (); expr->expr_type = EXPR_ARRAY; *************** gfc_match_array_constructor (gfc_expr ** *** 934,939 **** --- 962,975 ---- expr->value.constructor = head; /* Size must be calculated at resolution time. */ + if (seen_ts) + expr->ts = ts; + else + expr->ts.type = BT_UNKNOWN; + + if (expr->ts.cl) + expr->ts.cl->length_from_typespec = seen_ts; + expr->where = where; expr->rank = 1; *************** static enum *** 964,970 **** cons_state; static int ! check_element_type (gfc_expr *expr) { if (cons_state == CONS_BAD) return 0; /* Suppress further errors */ --- 1000,1006 ---- cons_state; static int ! check_element_type (gfc_expr *expr, bool convert) { if (cons_state == CONS_BAD) return 0; /* Suppress further errors */ *************** check_element_type (gfc_expr *expr) *** 985,990 **** --- 1021,1029 ---- if (gfc_compare_types (&constructor_ts, &expr->ts)) return 0; + if (convert) + return gfc_convert_type (expr, &constructor_ts, 1) == SUCCESS ? 0 : 1; + gfc_error ("Element in %s array constructor at %L is %s", gfc_typename (&constructor_ts), &expr->where, gfc_typename (&expr->ts)); *************** check_element_type (gfc_expr *expr) *** 996,1003 **** /* Recursive work function for gfc_check_constructor_type(). */ ! static try ! check_constructor_type (gfc_constructor *c) { gfc_expr *e; --- 1035,1042 ---- /* Recursive work function for gfc_check_constructor_type(). */ ! static gfc_try ! check_constructor_type (gfc_constructor *c, bool convert) { gfc_expr *e; *************** check_constructor_type (gfc_constructor *** 1007,1019 **** if (e->expr_type == EXPR_ARRAY) { ! if (check_constructor_type (e->value.constructor) == FAILURE) return FAILURE; continue; } ! if (check_element_type (e)) return FAILURE; } --- 1046,1058 ---- if (e->expr_type == EXPR_ARRAY) { ! if (check_constructor_type (e->value.constructor, convert) == FAILURE) return FAILURE; continue; } ! if (check_element_type (e, convert)) return FAILURE; } *************** check_constructor_type (gfc_constructor *** 1024,1038 **** /* Check that all elements of an array constructor are the same type. On FAILURE, an error has been generated. */ ! try gfc_check_constructor_type (gfc_expr *e) { ! try t; ! cons_state = CONS_START; ! gfc_clear_ts (&constructor_ts); ! t = check_constructor_type (e->value.constructor); if (t == SUCCESS && e->ts.type == BT_UNKNOWN) e->ts = constructor_ts; --- 1063,1087 ---- /* Check that all elements of an array constructor are the same type. On FAILURE, an error has been generated. */ ! gfc_try gfc_check_constructor_type (gfc_expr *e) { ! gfc_try t; ! if (e->ts.type != BT_UNKNOWN) ! { ! cons_state = CONS_GOOD; ! constructor_ts = e->ts; ! } ! else ! { ! cons_state = CONS_START; ! gfc_clear_ts (&constructor_ts); ! } ! /* If e->ts.type != BT_UNKNOWN, the array constructor included a ! typespec, and we will now convert the values on the fly. */ ! t = check_constructor_type (e->value.constructor, e->ts.type != BT_UNKNOWN); if (t == SUCCESS && e->ts.type == BT_UNKNOWN) e->ts = constructor_ts; *************** cons_stack; *** 1050,1061 **** static cons_stack *base; ! static try check_constructor (gfc_constructor *, try (*) (gfc_expr *)); /* Check an EXPR_VARIABLE expression in a constructor to make sure that that variable is an iteration variables. */ ! try gfc_check_iter_variable (gfc_expr *expr) { gfc_symbol *sym; --- 1099,1110 ---- static cons_stack *base; ! static gfc_try check_constructor (gfc_constructor *, gfc_try (*) (gfc_expr *)); /* Check an EXPR_VARIABLE expression in a constructor to make sure that that variable is an iteration variables. */ ! gfc_try gfc_check_iter_variable (gfc_expr *expr) { gfc_symbol *sym; *************** gfc_check_iter_variable (gfc_expr *expr) *** 1075,1086 **** to calling the check function for each expression in the constructor, giving variables with the names of iterators a pass. */ ! static try ! check_constructor (gfc_constructor *c, try (*check_function) (gfc_expr *)) { cons_stack element; gfc_expr *e; ! try t; for (; c; c = c->next) { --- 1124,1135 ---- to calling the check function for each expression in the constructor, giving variables with the names of iterators a pass. */ ! static gfc_try ! check_constructor (gfc_constructor *c, gfc_try (*check_function) (gfc_expr *)) { cons_stack element; gfc_expr *e; ! gfc_try t; for (; c; c = c->next) { *************** check_constructor (gfc_constructor *c, t *** 1113,1123 **** expression -- specification, restricted, or initialization as determined by the check_function. */ ! try ! gfc_check_constructor (gfc_expr *expr, try (*check_function) (gfc_expr *)) { cons_stack *base_save; ! try t; base_save = base; base = NULL; --- 1162,1172 ---- expression -- specification, restricted, or initialization as determined by the check_function. */ ! gfc_try ! gfc_check_constructor (gfc_expr *expr, gfc_try (*check_function) (gfc_expr *)) { cons_stack *base_save; ! gfc_try t; base_save = base; base = NULL; *************** typedef struct *** 1145,1163 **** gfc_component *component; mpz_t *repeat; ! try (*expand_work_function) (gfc_expr *); } expand_info; static expand_info current_expand; ! static try expand_constructor (gfc_constructor *); /* Work function that counts the number of elements present in a constructor. */ ! static try count_elements (gfc_expr *e) { mpz_t result; --- 1194,1212 ---- gfc_component *component; mpz_t *repeat; ! gfc_try (*expand_work_function) (gfc_expr *); } expand_info; static expand_info current_expand; ! static gfc_try expand_constructor (gfc_constructor *); /* Work function that counts the number of elements present in a constructor. */ ! static gfc_try count_elements (gfc_expr *e) { mpz_t result; *************** count_elements (gfc_expr *e) *** 1184,1190 **** /* Work function that extracts a particular element from an array constructor, freeing the rest. */ ! static try extract_element (gfc_expr *e) { --- 1233,1239 ---- /* Work function that extracts a particular element from an array constructor, freeing the rest. */ ! static gfc_try extract_element (gfc_expr *e) { *************** extract_element (gfc_expr *e) *** 1207,1213 **** /* Work function that constructs a new constructor out of the old one, stringing new elements together. */ ! static try expand (gfc_expr *e) { if (current_expand.new_head == NULL) --- 1256,1262 ---- /* Work function that constructs a new constructor out of the old one, stringing new elements together. */ ! static gfc_try expand (gfc_expr *e) { if (current_expand.new_head == NULL) *************** gfc_simplify_iterator_var (gfc_expr *e) *** 1255,1261 **** /* Expand an expression with that is inside of a constructor, recursing into other constructors if present. */ ! static try expand_expr (gfc_expr *e) { if (e->expr_type == EXPR_ARRAY) --- 1304,1310 ---- /* Expand an expression with that is inside of a constructor, recursing into other constructors if present. */ ! static gfc_try expand_expr (gfc_expr *e) { if (e->expr_type == EXPR_ARRAY) *************** expand_expr (gfc_expr *e) *** 1273,1285 **** } ! static try expand_iterator (gfc_constructor *c) { gfc_expr *start, *end, *step; iterator_stack frame; mpz_t trip; ! try t; end = step = NULL; --- 1322,1334 ---- } ! static gfc_try expand_iterator (gfc_constructor *c) { gfc_expr *start, *end, *step; iterator_stack frame; mpz_t trip; ! gfc_try t; end = step = NULL; *************** cleanup: *** 1357,1363 **** expressions. The work function needs to either save or free the passed expression. */ ! static try expand_constructor (gfc_constructor *c) { gfc_expr *e; --- 1406,1412 ---- expressions. The work function needs to either save or free the passed expression. */ ! static gfc_try expand_constructor (gfc_constructor *c) { gfc_expr *e; *************** expand_constructor (gfc_constructor *c) *** 1400,1413 **** /* Top level subroutine for expanding constructors. We only expand constructor if they are small enough. */ ! try gfc_expand_constructor (gfc_expr *e) { expand_info expand_save; gfc_expr *f; ! try rc; ! f = gfc_get_array_element (e, GFC_MAX_AC_EXPAND); if (f != NULL) { gfc_free_expr (f); --- 1449,1462 ---- /* Top level subroutine for expanding constructors. We only expand constructor if they are small enough. */ ! gfc_try gfc_expand_constructor (gfc_expr *e) { expand_info expand_save; gfc_expr *f; ! gfc_try rc; ! f = gfc_get_array_element (e, gfc_option.flag_max_array_constructor); if (f != NULL) { gfc_free_expr (f); *************** done: *** 1444,1450 **** constant, after removal of any iteration variables. We return FAILURE if not so. */ ! static try constant_element (gfc_expr *e) { int rv; --- 1493,1499 ---- constant, after removal of any iteration variables. We return FAILURE if not so. */ ! static gfc_try constant_element (gfc_expr *e) { int rv; *************** int *** 1466,1472 **** gfc_constant_ac (gfc_expr *e) { expand_info expand_save; ! try rc; iter_stack = NULL; expand_save = current_expand; --- 1515,1521 ---- gfc_constant_ac (gfc_expr *e) { expand_info expand_save; ! gfc_try rc; iter_stack = NULL; expand_save = current_expand; *************** gfc_expanded_ac (gfc_expr *e) *** 1504,1513 **** /* Recursive array list resolution function. All of the elements must be of the same type. */ ! static try resolve_array_list (gfc_constructor *p) { ! try t; t = SUCCESS; --- 1553,1562 ---- /* Recursive array list resolution function. All of the elements must be of the same type. */ ! static gfc_try resolve_array_list (gfc_constructor *p) { ! gfc_try t; t = SUCCESS; *************** resolve_array_list (gfc_constructor *p) *** 1524,1544 **** return t; } ! /* Resolve character array constructor. If it is a constant character array and ! not specified character length, update character length to the maximum of ! its element constructors' length. */ ! void gfc_resolve_character_array_constructor (gfc_expr *expr) { gfc_constructor *p; ! int max_length; gcc_assert (expr->expr_type == EXPR_ARRAY); gcc_assert (expr->ts.type == BT_CHARACTER); - max_length = -1; - if (expr->ts.cl == NULL) { for (p = expr->value.constructor; p; p = p->next) --- 1573,1592 ---- return t; } ! /* Resolve character array constructor. If it has a specified constant character ! length, pad/truncate the elements here; if the length is not specified and ! all elements are of compile-time known length, emit an error as this is ! invalid. */ ! gfc_try gfc_resolve_character_array_constructor (gfc_expr *expr) { gfc_constructor *p; ! int found_length; gcc_assert (expr->expr_type == EXPR_ARRAY); gcc_assert (expr->ts.type == BT_CHARACTER); if (expr->ts.cl == NULL) { for (p = expr->value.constructor; p; p = p->next) *************** gfc_resolve_character_array_constructor *** 1557,1570 **** got_charlen: if (expr->ts.cl->length == NULL) { ! /* Find the maximum length of the elements. Do nothing for variable ! array constructor, unless the character length is constant or ! there is a constant substring reference. */ for (p = expr->value.constructor; p; p = p->next) { gfc_ref *ref; for (ref = p->expr->ref; ref; ref = ref->next) if (ref->type == REF_SUBSTRING --- 1605,1620 ---- got_charlen: + found_length = -1; + if (expr->ts.cl->length == NULL) { ! /* Check that all constant string elements have the same length until ! we reach the end or find a variable-length one. */ for (p = expr->value.constructor; p; p = p->next) { + int current_length = -1; gfc_ref *ref; for (ref = p->expr->ref; ref; ref = ref->next) if (ref->type == REF_SUBSTRING *************** got_charlen: *** 1573,1622 **** break; if (p->expr->expr_type == EXPR_CONSTANT) ! max_length = MAX (p->expr->value.character.length, max_length); else if (ref) { long j; j = mpz_get_ui (ref->u.ss.end->value.integer) - mpz_get_ui (ref->u.ss.start->value.integer) + 1; ! max_length = MAX ((int) j, max_length); } else if (p->expr->ts.cl && p->expr->ts.cl->length && p->expr->ts.cl->length->expr_type == EXPR_CONSTANT) { long j; j = mpz_get_si (p->expr->ts.cl->length->value.integer); ! max_length = MAX ((int) j, max_length); } else ! return; ! } ! if (max_length != -1) ! { ! /* Update the character length of the array constructor. */ ! expr->ts.cl->length = gfc_int_expr (max_length); ! /* Update the element constructors. */ ! for (p = expr->value.constructor; p; p = p->next) ! if (p->expr->expr_type == EXPR_CONSTANT) ! gfc_set_constant_character_len (max_length, p->expr, true); } } } /* Resolve all of the expressions in an array list. */ ! try gfc_resolve_array_constructor (gfc_expr *expr) { ! try t; t = resolve_array_list (expr->value.constructor); if (t == SUCCESS) t = gfc_check_constructor_type (expr); ! if (t == SUCCESS && expr->ts.type == BT_CHARACTER) ! gfc_resolve_character_array_constructor (expr); return t; } --- 1623,1725 ---- break; if (p->expr->expr_type == EXPR_CONSTANT) ! current_length = p->expr->value.character.length; else if (ref) { long j; j = mpz_get_ui (ref->u.ss.end->value.integer) - mpz_get_ui (ref->u.ss.start->value.integer) + 1; ! current_length = (int) j; } else if (p->expr->ts.cl && p->expr->ts.cl->length && p->expr->ts.cl->length->expr_type == EXPR_CONSTANT) { long j; j = mpz_get_si (p->expr->ts.cl->length->value.integer); ! current_length = (int) j; } else ! return SUCCESS; ! gcc_assert (current_length != -1); ! ! if (found_length == -1) ! found_length = current_length; ! else if (found_length != current_length) ! { ! gfc_error ("Different CHARACTER lengths (%d/%d) in array" ! " constructor at %L", found_length, current_length, ! &p->expr->where); ! return FAILURE; ! } ! ! gcc_assert (found_length == current_length); } + + gcc_assert (found_length != -1); + + /* Update the character length of the array constructor. */ + expr->ts.cl->length = gfc_int_expr (found_length); + } + else + { + /* We've got a character length specified. It should be an integer, + otherwise an error is signalled elsewhere. */ + gcc_assert (expr->ts.cl->length); + + /* If we've got a constant character length, pad according to this. + gfc_extract_int does check for BT_INTEGER and EXPR_CONSTANT and sets + max_length only if they pass. */ + gfc_extract_int (expr->ts.cl->length, &found_length); + + /* Now pad/truncate the elements accordingly to the specified character + length. This is ok inside this conditional, as in the case above + (without typespec) all elements are verified to have the same length + anyway. */ + if (found_length != -1) + for (p = expr->value.constructor; p; p = p->next) + if (p->expr->expr_type == EXPR_CONSTANT) + { + gfc_expr *cl = NULL; + int current_length = -1; + bool has_ts; + + if (p->expr->ts.cl && p->expr->ts.cl->length) + { + cl = p->expr->ts.cl->length; + gfc_extract_int (cl, ¤t_length); + } + + /* If gfc_extract_int above set current_length, we implicitly + know the type is BT_INTEGER and it's EXPR_CONSTANT. */ + + has_ts = (expr->ts.cl && expr->ts.cl->length_from_typespec); + + if (! cl + || (current_length != -1 && current_length < found_length)) + gfc_set_constant_character_len (found_length, p->expr, + has_ts ? -1 : found_length); + } } + + return SUCCESS; } /* Resolve all of the expressions in an array list. */ ! gfc_try gfc_resolve_array_constructor (gfc_expr *expr) { ! gfc_try t; t = resolve_array_list (expr->value.constructor); if (t == SUCCESS) t = gfc_check_constructor_type (expr); ! ! /* gfc_resolve_character_array_constructor is called in gfc_resolve_expr after ! the call to this function, so we don't need to call it here; if it was ! called twice, an error message there would be duplicated. */ return t; } *************** gfc_get_array_element (gfc_expr *array, *** 1689,1695 **** { expand_info expand_save; gfc_expr *e; ! try rc; expand_save = current_expand; current_expand.extract_n = element; --- 1792,1798 ---- { expand_info expand_save; gfc_expr *e; ! gfc_try rc; expand_save = current_expand; current_expand.extract_n = element; *************** gfc_get_array_element (gfc_expr *array, *** 1720,1726 **** /* Get the size of single dimension of an array specification. The array is guaranteed to be one dimensional. */ ! try spec_dimen_size (gfc_array_spec *as, int dimen, mpz_t *result) { if (as == NULL) --- 1823,1829 ---- /* Get the size of single dimension of an array specification. The array is guaranteed to be one dimensional. */ ! gfc_try spec_dimen_size (gfc_array_spec *as, int dimen, mpz_t *result) { if (as == NULL) *************** spec_dimen_size (gfc_array_spec *as, int *** 1747,1753 **** } ! try spec_size (gfc_array_spec *as, mpz_t *result) { mpz_t size; --- 1850,1856 ---- } ! gfc_try spec_size (gfc_array_spec *as, mpz_t *result) { mpz_t size; *************** spec_size (gfc_array_spec *as, mpz_t *re *** 1773,1786 **** /* Get the number of elements in an array section. */ ! static try ! ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result) { mpz_t upper, lower, stride; ! try t; if (dimen < 0 || ar == NULL || dimen > ar->dimen - 1) ! gfc_internal_error ("ref_dimen_size(): Bad dimension"); switch (ar->dimen_type[dimen]) { --- 1876,1889 ---- /* Get the number of elements in an array section. */ ! gfc_try ! gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result) { mpz_t upper, lower, stride; ! gfc_try t; if (dimen < 0 || ar == NULL || dimen > ar->dimen - 1) ! gfc_internal_error ("gfc_ref_dimen_size(): Bad dimension"); switch (ar->dimen_type[dimen]) { *************** ref_dimen_size (gfc_array_ref *ar, int d *** 1854,1867 **** return t; default: ! gfc_internal_error ("ref_dimen_size(): Bad dimen_type"); } return t; } ! static try ref_size (gfc_array_ref *ar, mpz_t *result) { mpz_t size; --- 1957,1970 ---- return t; default: ! gfc_internal_error ("gfc_ref_dimen_size(): Bad dimen_type"); } return t; } ! static gfc_try ref_size (gfc_array_ref *ar, mpz_t *result) { mpz_t size; *************** ref_size (gfc_array_ref *ar, mpz_t *resu *** 1871,1877 **** for (d = 0; d < ar->dimen; d++) { ! if (ref_dimen_size (ar, d, &size) == FAILURE) { mpz_clear (*result); return FAILURE; --- 1974,1980 ---- for (d = 0; d < ar->dimen; d++) { ! if (gfc_ref_dimen_size (ar, d, &size) == FAILURE) { mpz_clear (*result); return FAILURE; *************** ref_size (gfc_array_ref *ar, mpz_t *resu *** 1890,1896 **** able to return a result in the 'result' variable, FAILURE otherwise. */ ! try gfc_array_dimen_size (gfc_expr *array, int dimen, mpz_t *result) { gfc_ref *ref; --- 1993,1999 ---- able to return a result in the 'result' variable, FAILURE otherwise. */ ! gfc_try gfc_array_dimen_size (gfc_expr *array, int dimen, mpz_t *result) { gfc_ref *ref; *************** gfc_array_dimen_size (gfc_expr *array, i *** 1917,1923 **** if (ref->u.ar.dimen_type[i] != DIMEN_ELEMENT) dimen--; ! return ref_dimen_size (&ref->u.ar, i - 1, result); } } --- 2020,2026 ---- if (ref->u.ar.dimen_type[i] != DIMEN_ELEMENT) dimen--; ! return gfc_ref_dimen_size (&ref->u.ar, i - 1, result); } } *************** gfc_array_dimen_size (gfc_expr *array, i *** 1958,1976 **** array. Returns SUCCESS if this is possible, and sets the 'result' variable. Otherwise returns FAILURE. */ ! try gfc_array_size (gfc_expr *array, mpz_t *result) { expand_info expand_save; gfc_ref *ref; ! int i, flag; ! try t; switch (array->expr_type) { case EXPR_ARRAY: ! flag = gfc_suppress_error; ! gfc_suppress_error = 1; expand_save = current_expand; --- 2061,2078 ---- array. Returns SUCCESS if this is possible, and sets the 'result' variable. Otherwise returns FAILURE. */ ! gfc_try gfc_array_size (gfc_expr *array, mpz_t *result) { expand_info expand_save; gfc_ref *ref; ! int i; ! gfc_try t; switch (array->expr_type) { case EXPR_ARRAY: ! gfc_push_suppress_errors (); expand_save = current_expand; *************** gfc_array_size (gfc_expr *array, mpz_t * *** 1981,1987 **** iter_stack = NULL; t = expand_constructor (array->value.constructor); ! gfc_suppress_error = flag; if (t == FAILURE) mpz_clear (*result); --- 2083,2090 ---- iter_stack = NULL; t = expand_constructor (array->value.constructor); ! ! gfc_pop_suppress_errors (); if (t == FAILURE) mpz_clear (*result); *************** gfc_array_size (gfc_expr *array, mpz_t * *** 2023,2029 **** /* Given an array reference, return the shape of the reference in an array of mpz_t integers. */ ! try gfc_array_ref_shape (gfc_array_ref *ar, mpz_t *shape) { int d; --- 2126,2132 ---- /* Given an array reference, return the shape of the reference in an array of mpz_t integers. */ ! gfc_try gfc_array_ref_shape (gfc_array_ref *ar, mpz_t *shape) { int d; *************** gfc_array_ref_shape (gfc_array_ref *ar, *** 2045,2051 **** { if (ar->dimen_type[i] != DIMEN_ELEMENT) { ! if (ref_dimen_size (ar, i, &shape[d]) == FAILURE) goto cleanup; d++; } --- 2148,2154 ---- { if (ar->dimen_type[i] != DIMEN_ELEMENT) { ! if (gfc_ref_dimen_size (ar, i, &shape[d]) == FAILURE) goto cleanup; d++; } diff -Nrcpad gcc-4.3.3/gcc/fortran/bbt.c gcc-4.4.0/gcc/fortran/bbt.c *** gcc-4.3.3/gcc/fortran/bbt.c Wed Aug 1 16:29:36 2007 --- gcc-4.4.0/gcc/fortran/bbt.c Sat Jul 19 16:23:52 2008 *************** *** 1,5 **** /* Balanced binary trees using treaps. ! Copyright (C) 2000, 2002, 2003, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Balanced binary trees using treaps. ! Copyright (C) 2000, 2002, 2003, 2007, 2008 Free Software Foundation, Inc. Contributed by Andy Vaught *************** rotate_right (gfc_bbt *t) *** 93,116 **** aborts if we find a duplicate key. */ static gfc_bbt * ! insert (gfc_bbt *new, gfc_bbt *t, compare_fn compare) { int c; if (t == NULL) ! return new; ! c = (*compare) (new, t); if (c < 0) { ! t->left = insert (new, t->left, compare); if (t->priority < t->left->priority) t = rotate_right (t); } else if (c > 0) { ! t->right = insert (new, t->right, compare); if (t->priority < t->right->priority) t = rotate_left (t); } --- 93,116 ---- aborts if we find a duplicate key. */ static gfc_bbt * ! insert (gfc_bbt *new_bbt, gfc_bbt *t, compare_fn compare) { int c; if (t == NULL) ! return new_bbt; ! c = (*compare) (new_bbt, t); if (c < 0) { ! t->left = insert (new_bbt, t->left, compare); if (t->priority < t->left->priority) t = rotate_right (t); } else if (c > 0) { ! t->right = insert (new_bbt, t->right, compare); if (t->priority < t->right->priority) t = rotate_left (t); } *************** insert (gfc_bbt *new, gfc_bbt *t, compar *** 126,137 **** already exists. */ void ! gfc_insert_bbt (void *root, void *new, compare_fn compare) { gfc_bbt **r, *n; r = (gfc_bbt **) root; ! n = (gfc_bbt *) new; n->priority = pseudo_random (); *r = insert (n, *r, compare); } --- 126,137 ---- already exists. */ void ! gfc_insert_bbt (void *root, void *new_node, compare_fn compare) { gfc_bbt **r, *n; r = (gfc_bbt **) root; ! n = (gfc_bbt *) new_node; n->priority = pseudo_random (); *r = insert (n, *r, compare); } diff -Nrcpad gcc-4.3.3/gcc/fortran/check.c gcc-4.4.0/gcc/fortran/check.c *** gcc-4.3.3/gcc/fortran/check.c Sun Jan 13 21:28:30 2008 --- gcc-4.4.0/gcc/fortran/check.c Fri Jan 9 23:47:55 2009 *************** *** 1,5 **** /* Check functions ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb --- 1,5 ---- /* Check functions ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb *************** along with GCC; see the file COPYING3. *** 35,41 **** /* Make sure an expression is a scalar. */ ! static try scalar_check (gfc_expr *e, int n) { if (e->rank == 0) --- 35,41 ---- /* Make sure an expression is a scalar. */ ! static gfc_try scalar_check (gfc_expr *e, int n) { if (e->rank == 0) *************** scalar_check (gfc_expr *e, int n) *** 50,56 **** /* Check the type of an expression. */ ! static try type_check (gfc_expr *e, int n, bt type) { if (e->ts.type == type) --- 50,56 ---- /* Check the type of an expression. */ ! static gfc_try type_check (gfc_expr *e, int n, bt type) { if (e->ts.type == type) *************** type_check (gfc_expr *e, int n, bt type) *** 66,72 **** /* Check that the expression is a numeric type. */ ! static try numeric_check (gfc_expr *e, int n) { if (gfc_numeric_ts (&e->ts)) --- 66,72 ---- /* Check that the expression is a numeric type. */ ! static gfc_try numeric_check (gfc_expr *e, int n) { if (gfc_numeric_ts (&e->ts)) *************** numeric_check (gfc_expr *e, int n) *** 93,99 **** /* Check that an expression is integer or real. */ ! static try int_or_real_check (gfc_expr *e, int n) { if (e->ts.type != BT_INTEGER && e->ts.type != BT_REAL) --- 93,99 ---- /* Check that an expression is integer or real. */ ! static gfc_try int_or_real_check (gfc_expr *e, int n) { if (e->ts.type != BT_INTEGER && e->ts.type != BT_REAL) *************** int_or_real_check (gfc_expr *e, int n) *** 110,116 **** /* Check that an expression is real or complex. */ ! static try real_or_complex_check (gfc_expr *e, int n) { if (e->ts.type != BT_REAL && e->ts.type != BT_COMPLEX) --- 110,116 ---- /* Check that an expression is real or complex. */ ! static gfc_try real_or_complex_check (gfc_expr *e, int n) { if (e->ts.type != BT_REAL && e->ts.type != BT_COMPLEX) *************** real_or_complex_check (gfc_expr *e, int *** 128,134 **** /* Check that the expression is an optional constant integer and that it specifies a valid kind for that type. */ ! static try kind_check (gfc_expr *k, int n, bt type) { int kind; --- 128,134 ---- /* Check that the expression is an optional constant integer and that it specifies a valid kind for that type. */ ! static gfc_try kind_check (gfc_expr *k, int n, bt type) { int kind; *************** kind_check (gfc_expr *k, int n, bt type) *** 164,170 **** /* Make sure the expression is a double precision real. */ ! static try double_check (gfc_expr *d, int n) { if (type_check (d, n, BT_REAL) == FAILURE) --- 164,170 ---- /* Make sure the expression is a double precision real. */ ! static gfc_try double_check (gfc_expr *d, int n) { if (type_check (d, n, BT_REAL) == FAILURE) *************** double_check (gfc_expr *d, int n) *** 184,190 **** /* Make sure the expression is a logical array. */ ! static try logical_array_check (gfc_expr *array, int n) { if (array->ts.type != BT_LOGICAL || array->rank == 0) --- 184,190 ---- /* Make sure the expression is a logical array. */ ! static gfc_try logical_array_check (gfc_expr *array, int n) { if (array->ts.type != BT_LOGICAL || array->rank == 0) *************** logical_array_check (gfc_expr *array, in *** 201,207 **** /* Make sure an expression is an array. */ ! static try array_check (gfc_expr *e, int n) { if (e->rank != 0) --- 201,207 ---- /* Make sure an expression is an array. */ ! static gfc_try array_check (gfc_expr *e, int n) { if (e->rank != 0) *************** array_check (gfc_expr *e, int n) *** 216,222 **** /* Make sure two expressions have the same type. */ ! static try same_type_check (gfc_expr *e, int n, gfc_expr *f, int m) { if (gfc_compare_types (&e->ts, &f->ts)) --- 216,222 ---- /* Make sure two expressions have the same type. */ ! static gfc_try same_type_check (gfc_expr *e, int n, gfc_expr *f, int m) { if (gfc_compare_types (&e->ts, &f->ts)) *************** same_type_check (gfc_expr *e, int n, gfc *** 232,238 **** /* Make sure that an expression has a certain (nonzero) rank. */ ! static try rank_check (gfc_expr *e, int n, int rank) { if (e->rank == rank) --- 232,238 ---- /* Make sure that an expression has a certain (nonzero) rank. */ ! static gfc_try rank_check (gfc_expr *e, int n, int rank) { if (e->rank == rank) *************** rank_check (gfc_expr *e, int n, int rank *** 248,254 **** /* Make sure a variable expression is not an optional dummy argument. */ ! static try nonoptional_check (gfc_expr *e, int n) { if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.optional) --- 248,254 ---- /* Make sure a variable expression is not an optional dummy argument. */ ! static gfc_try nonoptional_check (gfc_expr *e, int n) { if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.optional) *************** nonoptional_check (gfc_expr *e, int n) *** 266,272 **** /* Check that an expression has a particular kind. */ ! static try kind_value_check (gfc_expr *e, int n, int k) { if (e->ts.kind == k) --- 266,272 ---- /* Check that an expression has a particular kind. */ ! static gfc_try kind_value_check (gfc_expr *e, int n, int k) { if (e->ts.kind == k) *************** kind_value_check (gfc_expr *e, int n, in *** 282,288 **** /* Make sure an expression is a variable. */ ! static try variable_check (gfc_expr *e, int n) { if ((e->expr_type == EXPR_VARIABLE --- 282,288 ---- /* Make sure an expression is a variable. */ ! static gfc_try variable_check (gfc_expr *e, int n) { if ((e->expr_type == EXPR_VARIABLE *************** variable_check (gfc_expr *e, int n) *** 309,315 **** /* Check the common DIM parameter for correctness. */ ! static try dim_check (gfc_expr *dim, int n, bool optional) { if (dim == NULL) --- 309,315 ---- /* Check the common DIM parameter for correctness. */ ! static gfc_try dim_check (gfc_expr *dim, int n, bool optional) { if (dim == NULL) *************** dim_check (gfc_expr *dim, int n, bool op *** 333,354 **** allow_assumed is zero then dim must be less than the rank of the array for assumed size arrays. */ ! static try dim_rank_check (gfc_expr *dim, gfc_expr *array, int allow_assumed) { gfc_array_ref *ar; int rank; ! if (dim->expr_type != EXPR_CONSTANT || array->expr_type != EXPR_VARIABLE) return SUCCESS; - ar = gfc_find_array_ref (array); rank = array->rank; ! if (ar->as->type == AS_ASSUMED_SIZE ! && !allow_assumed ! && ar->type != AR_ELEMENT ! && ar->type != AR_SECTION) ! rank--; if (mpz_cmp_ui (dim->value.integer, 1) < 0 || mpz_cmp_ui (dim->value.integer, rank) > 0) --- 333,359 ---- allow_assumed is zero then dim must be less than the rank of the array for assumed size arrays. */ ! static gfc_try dim_rank_check (gfc_expr *dim, gfc_expr *array, int allow_assumed) { gfc_array_ref *ar; int rank; ! if (dim->expr_type != EXPR_CONSTANT ! || (array->expr_type != EXPR_VARIABLE ! && array->expr_type != EXPR_ARRAY)) return SUCCESS; rank = array->rank; ! if (array->expr_type == EXPR_VARIABLE) ! { ! ar = gfc_find_array_ref (array); ! if (ar->as->type == AS_ASSUMED_SIZE ! && !allow_assumed ! && ar->type != AR_ELEMENT ! && ar->type != AR_SECTION) ! rank--; ! } if (mpz_cmp_ui (dim->value.integer, 1) < 0 || mpz_cmp_ui (dim->value.integer, rank) > 0) *************** identical_dimen_shape (gfc_expr *a, int *** 396,403 **** /* Check whether two character expressions have the same length; returns SUCCESS if they have or if the length cannot be determined. */ ! static try ! check_same_strlen (const gfc_expr *a, const gfc_expr *b, const char *name) { long len_a, len_b; len_a = len_b = -1; --- 401,408 ---- /* Check whether two character expressions have the same length; returns SUCCESS if they have or if the length cannot be determined. */ ! gfc_try ! gfc_check_same_strlen (const gfc_expr *a, const gfc_expr *b, const char *name) { long len_a, len_b; len_a = len_b = -1; *************** check_same_strlen (const gfc_expr *a, co *** 423,430 **** if (len_a == len_b) return SUCCESS; ! gfc_error ("Unequal character lengths (%ld and %ld) in %s intrinsic " ! "at %L", len_a, len_b, name, &a->where); return FAILURE; } --- 428,435 ---- if (len_a == len_b) return SUCCESS; ! gfc_error ("Unequal character lengths (%ld/%ld) in %s at %L", ! len_a, len_b, name, &a->where); return FAILURE; } *************** check_same_strlen (const gfc_expr *a, co *** 434,440 **** /* Check subroutine suitable for intrinsics taking a real argument and a kind argument for the result. */ ! static try check_a_kind (gfc_expr *a, gfc_expr *kind, bt type) { if (type_check (a, 0, BT_REAL) == FAILURE) --- 439,445 ---- /* Check subroutine suitable for intrinsics taking a real argument and a kind argument for the result. */ ! static gfc_try check_a_kind (gfc_expr *a, gfc_expr *kind, bt type) { if (type_check (a, 0, BT_REAL) == FAILURE) *************** check_a_kind (gfc_expr *a, gfc_expr *kin *** 448,454 **** /* Check subroutine suitable for ceiling, floor and nint. */ ! try gfc_check_a_ikind (gfc_expr *a, gfc_expr *kind) { return check_a_kind (a, kind, BT_INTEGER); --- 453,459 ---- /* Check subroutine suitable for ceiling, floor and nint. */ ! gfc_try gfc_check_a_ikind (gfc_expr *a, gfc_expr *kind) { return check_a_kind (a, kind, BT_INTEGER); *************** gfc_check_a_ikind (gfc_expr *a, gfc_expr *** 457,470 **** /* Check subroutine suitable for aint, anint. */ ! try gfc_check_a_xkind (gfc_expr *a, gfc_expr *kind) { return check_a_kind (a, kind, BT_REAL); } ! try gfc_check_abs (gfc_expr *a) { if (numeric_check (a, 0) == FAILURE) --- 462,475 ---- /* Check subroutine suitable for aint, anint. */ ! gfc_try gfc_check_a_xkind (gfc_expr *a, gfc_expr *kind) { return check_a_kind (a, kind, BT_REAL); } ! gfc_try gfc_check_abs (gfc_expr *a) { if (numeric_check (a, 0) == FAILURE) *************** gfc_check_abs (gfc_expr *a) *** 474,480 **** } ! try gfc_check_achar (gfc_expr *a, gfc_expr *kind) { if (type_check (a, 0, BT_INTEGER) == FAILURE) --- 479,485 ---- } ! gfc_try gfc_check_achar (gfc_expr *a, gfc_expr *kind) { if (type_check (a, 0, BT_INTEGER) == FAILURE) *************** gfc_check_achar (gfc_expr *a, gfc_expr * *** 486,507 **** } ! try gfc_check_access_func (gfc_expr *name, gfc_expr *mode) { if (type_check (name, 0, BT_CHARACTER) == FAILURE || scalar_check (name, 0) == FAILURE) return FAILURE; if (type_check (mode, 1, BT_CHARACTER) == FAILURE || scalar_check (mode, 1) == FAILURE) return FAILURE; return SUCCESS; } ! try gfc_check_all_any (gfc_expr *mask, gfc_expr *dim) { if (logical_array_check (mask, 0) == FAILURE) --- 491,516 ---- } ! gfc_try gfc_check_access_func (gfc_expr *name, gfc_expr *mode) { if (type_check (name, 0, BT_CHARACTER) == FAILURE || scalar_check (name, 0) == FAILURE) return FAILURE; + if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (type_check (mode, 1, BT_CHARACTER) == FAILURE || scalar_check (mode, 1) == FAILURE) return FAILURE; + if (kind_value_check (mode, 1, gfc_default_character_kind) == FAILURE) + return FAILURE; return SUCCESS; } ! gfc_try gfc_check_all_any (gfc_expr *mask, gfc_expr *dim) { if (logical_array_check (mask, 0) == FAILURE) *************** gfc_check_all_any (gfc_expr *mask, gfc_e *** 514,520 **** } ! try gfc_check_allocated (gfc_expr *array) { symbol_attribute attr; --- 523,529 ---- } ! gfc_try gfc_check_allocated (gfc_expr *array) { symbol_attribute attr; *************** gfc_check_allocated (gfc_expr *array) *** 541,547 **** /* Common check function where the first argument must be real or integer and the second argument must be the same as the first. */ ! try gfc_check_a_p (gfc_expr *a, gfc_expr *p) { if (int_or_real_check (a, 0) == FAILURE) --- 550,556 ---- /* Common check function where the first argument must be real or integer and the second argument must be the same as the first. */ ! gfc_try gfc_check_a_p (gfc_expr *a, gfc_expr *p) { if (int_or_real_check (a, 0) == FAILURE) *************** gfc_check_a_p (gfc_expr *a, gfc_expr *p) *** 567,573 **** } ! try gfc_check_x_yd (gfc_expr *x, gfc_expr *y) { if (double_check (x, 0) == FAILURE || double_check (y, 1) == FAILURE) --- 576,582 ---- } ! gfc_try gfc_check_x_yd (gfc_expr *x, gfc_expr *y) { if (double_check (x, 0) == FAILURE || double_check (y, 1) == FAILURE) *************** gfc_check_x_yd (gfc_expr *x, gfc_expr *y *** 577,602 **** } ! try gfc_check_associated (gfc_expr *pointer, gfc_expr *target) { ! symbol_attribute attr; int i; ! try t; locus *where; where = &pointer->where; if (pointer->expr_type == EXPR_VARIABLE) ! attr = gfc_variable_attr (pointer, NULL); else if (pointer->expr_type == EXPR_FUNCTION) ! attr = pointer->symtree->n.sym->attr; else if (pointer->expr_type == EXPR_NULL) goto null_arg; else gcc_assert (0); /* Pointer must be a variable or a function. */ ! if (!attr.pointer) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER", gfc_current_intrinsic_arg[0], gfc_current_intrinsic, --- 586,611 ---- } ! gfc_try gfc_check_associated (gfc_expr *pointer, gfc_expr *target) { ! symbol_attribute attr1, attr2; int i; ! gfc_try t; locus *where; where = &pointer->where; if (pointer->expr_type == EXPR_VARIABLE) ! attr1 = gfc_variable_attr (pointer, NULL); else if (pointer->expr_type == EXPR_FUNCTION) ! attr1 = pointer->symtree->n.sym->attr; else if (pointer->expr_type == EXPR_NULL) goto null_arg; else gcc_assert (0); /* Pointer must be a variable or a function. */ ! if (!attr1.pointer && !attr1.proc_pointer) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER", gfc_current_intrinsic_arg[0], gfc_current_intrinsic, *************** gfc_check_associated (gfc_expr *pointer, *** 613,621 **** goto null_arg; if (target->expr_type == EXPR_VARIABLE) ! attr = gfc_variable_attr (target, NULL); else if (target->expr_type == EXPR_FUNCTION) ! attr = target->symtree->n.sym->attr; else { gfc_error ("'%s' argument of '%s' intrinsic at %L must be a pointer " --- 622,630 ---- goto null_arg; if (target->expr_type == EXPR_VARIABLE) ! attr2 = gfc_variable_attr (target, NULL); else if (target->expr_type == EXPR_FUNCTION) ! attr2 = target->symtree->n.sym->attr; else { gfc_error ("'%s' argument of '%s' intrinsic at %L must be a pointer " *************** gfc_check_associated (gfc_expr *pointer, *** 624,630 **** return FAILURE; } ! if (!attr.pointer && !attr.target) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER " "or a TARGET", gfc_current_intrinsic_arg[1], --- 633,639 ---- return FAILURE; } ! if (attr1.pointer && !attr2.pointer && !attr2.target) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER " "or a TARGET", gfc_current_intrinsic_arg[1], *************** null_arg: *** 660,666 **** } ! try gfc_check_atan2 (gfc_expr *y, gfc_expr *x) { if (type_check (y, 0, BT_REAL) == FAILURE) --- 669,675 ---- } ! gfc_try gfc_check_atan2 (gfc_expr *y, gfc_expr *x) { if (type_check (y, 0, BT_REAL) == FAILURE) *************** gfc_check_atan2 (gfc_expr *y, gfc_expr * *** 674,680 **** /* BESJN and BESYN functions. */ ! try gfc_check_besn (gfc_expr *n, gfc_expr *x) { if (type_check (n, 0, BT_INTEGER) == FAILURE) --- 683,689 ---- /* BESJN and BESYN functions. */ ! gfc_try gfc_check_besn (gfc_expr *n, gfc_expr *x) { if (type_check (n, 0, BT_INTEGER) == FAILURE) *************** gfc_check_besn (gfc_expr *n, gfc_expr *x *** 687,693 **** } ! try gfc_check_btest (gfc_expr *i, gfc_expr *pos) { if (type_check (i, 0, BT_INTEGER) == FAILURE) --- 696,702 ---- } ! gfc_try gfc_check_btest (gfc_expr *i, gfc_expr *pos) { if (type_check (i, 0, BT_INTEGER) == FAILURE) *************** gfc_check_btest (gfc_expr *i, gfc_expr * *** 699,705 **** } ! try gfc_check_char (gfc_expr *i, gfc_expr *kind) { if (type_check (i, 0, BT_INTEGER) == FAILURE) --- 708,714 ---- } ! gfc_try gfc_check_char (gfc_expr *i, gfc_expr *kind) { if (type_check (i, 0, BT_INTEGER) == FAILURE) *************** gfc_check_char (gfc_expr *i, gfc_expr *k *** 711,738 **** } ! try gfc_check_chdir (gfc_expr *dir) { if (type_check (dir, 0, BT_CHARACTER) == FAILURE) return FAILURE; return SUCCESS; } ! try gfc_check_chdir_sub (gfc_expr *dir, gfc_expr *status) { if (type_check (dir, 0, BT_CHARACTER) == FAILURE) return FAILURE; if (status == NULL) return SUCCESS; if (type_check (status, 1, BT_INTEGER) == FAILURE) return FAILURE; - if (scalar_check (status, 1) == FAILURE) return FAILURE; --- 720,750 ---- } ! gfc_try gfc_check_chdir (gfc_expr *dir) { if (type_check (dir, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (dir, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; return SUCCESS; } ! gfc_try gfc_check_chdir_sub (gfc_expr *dir, gfc_expr *status) { if (type_check (dir, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (dir, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (status == NULL) return SUCCESS; if (type_check (status, 1, BT_INTEGER) == FAILURE) return FAILURE; if (scalar_check (status, 1) == FAILURE) return FAILURE; *************** gfc_check_chdir_sub (gfc_expr *dir, gfc_ *** 740,766 **** } ! try gfc_check_chmod (gfc_expr *name, gfc_expr *mode) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) return FAILURE; if (type_check (mode, 1, BT_CHARACTER) == FAILURE) return FAILURE; return SUCCESS; } ! try gfc_check_chmod_sub (gfc_expr *name, gfc_expr *mode, gfc_expr *status) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) return FAILURE; if (type_check (mode, 1, BT_CHARACTER) == FAILURE) return FAILURE; if (status == NULL) return SUCCESS; --- 752,786 ---- } ! gfc_try gfc_check_chmod (gfc_expr *name, gfc_expr *mode) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (type_check (mode, 1, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (mode, 1, gfc_default_character_kind) == FAILURE) + return FAILURE; return SUCCESS; } ! gfc_try gfc_check_chmod_sub (gfc_expr *name, gfc_expr *mode, gfc_expr *status) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (type_check (mode, 1, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (mode, 1, gfc_default_character_kind) == FAILURE) + return FAILURE; if (status == NULL) return SUCCESS; *************** gfc_check_chmod_sub (gfc_expr *name, gfc *** 775,781 **** } ! try gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind) { if (numeric_check (x, 0) == FAILURE) --- 795,801 ---- } ! gfc_try gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind) { if (numeric_check (x, 0) == FAILURE) *************** gfc_check_cmplx (gfc_expr *x, gfc_expr * *** 802,808 **** } ! try gfc_check_complex (gfc_expr *x, gfc_expr *y) { if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL) --- 822,828 ---- } ! gfc_try gfc_check_complex (gfc_expr *x, gfc_expr *y) { if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL) *************** gfc_check_complex (gfc_expr *x, gfc_expr *** 829,835 **** } ! try gfc_check_count (gfc_expr *mask, gfc_expr *dim, gfc_expr *kind) { if (logical_array_check (mask, 0) == FAILURE) --- 849,855 ---- } ! gfc_try gfc_check_count (gfc_expr *mask, gfc_expr *dim, gfc_expr *kind) { if (logical_array_check (mask, 0) == FAILURE) *************** gfc_check_count (gfc_expr *mask, gfc_exp *** 847,853 **** } ! try gfc_check_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim) { if (array_check (array, 0) == FAILURE) --- 867,873 ---- } ! gfc_try gfc_check_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim) { if (array_check (array, 0) == FAILURE) *************** gfc_check_cshift (gfc_expr *array, gfc_e *** 861,871 **** if (scalar_check (shift, 1) == FAILURE) return FAILURE; } ! else { ! /* TODO: more requirements on shift parameter. */ } if (dim_check (dim, 2, true) == FAILURE) return FAILURE; --- 881,896 ---- if (scalar_check (shift, 1) == FAILURE) return FAILURE; } ! else if (shift->rank != array->rank - 1 && shift->rank != 0) { ! gfc_error ("SHIFT argument at %L of CSHIFT must have rank %d or be a " ! "scalar", &shift->where, array->rank - 1); ! return FAILURE; } + /* TODO: Add shape conformance check between array (w/o dimension dim) + and shift. */ + if (dim_check (dim, 2, true) == FAILURE) return FAILURE; *************** gfc_check_cshift (gfc_expr *array, gfc_e *** 873,879 **** } ! try gfc_check_ctime (gfc_expr *time) { if (scalar_check (time, 0) == FAILURE) --- 898,904 ---- } ! gfc_try gfc_check_ctime (gfc_expr *time) { if (scalar_check (time, 0) == FAILURE) *************** gfc_check_ctime (gfc_expr *time) *** 886,892 **** } ! try gfc_check_datan2 (gfc_expr *y, gfc_expr *x) { if (double_check (y, 0) == FAILURE || double_check (x, 1) == FAILURE) return FAILURE; --- 911,917 ---- } ! gfc_try gfc_check_datan2 (gfc_expr *y, gfc_expr *x) { if (double_check (y, 0) == FAILURE || double_check (x, 1) == FAILURE) return FAILURE; *************** try gfc_check_datan2 (gfc_expr *y, gfc_e *** 894,900 **** return SUCCESS; } ! try gfc_check_dcmplx (gfc_expr *x, gfc_expr *y) { if (numeric_check (x, 0) == FAILURE) --- 919,925 ---- return SUCCESS; } ! gfc_try gfc_check_dcmplx (gfc_expr *x, gfc_expr *y) { if (numeric_check (x, 0) == FAILURE) *************** gfc_check_dcmplx (gfc_expr *x, gfc_expr *** 918,924 **** } ! try gfc_check_dble (gfc_expr *x) { if (numeric_check (x, 0) == FAILURE) --- 943,949 ---- } ! gfc_try gfc_check_dble (gfc_expr *x) { if (numeric_check (x, 0) == FAILURE) *************** gfc_check_dble (gfc_expr *x) *** 928,934 **** } ! try gfc_check_digits (gfc_expr *x) { if (int_or_real_check (x, 0) == FAILURE) --- 953,959 ---- } ! gfc_try gfc_check_digits (gfc_expr *x) { if (int_or_real_check (x, 0) == FAILURE) *************** gfc_check_digits (gfc_expr *x) *** 938,944 **** } ! try gfc_check_dot_product (gfc_expr *vector_a, gfc_expr *vector_b) { switch (vector_a->ts.type) --- 963,969 ---- } ! gfc_try gfc_check_dot_product (gfc_expr *vector_a, gfc_expr *vector_b) { switch (vector_a->ts.type) *************** gfc_check_dot_product (gfc_expr *vector_ *** 980,986 **** } ! try gfc_check_dprod (gfc_expr *x, gfc_expr *y) { if (type_check (x, 0, BT_REAL) == FAILURE --- 1005,1011 ---- } ! gfc_try gfc_check_dprod (gfc_expr *x, gfc_expr *y) { if (type_check (x, 0, BT_REAL) == FAILURE *************** gfc_check_dprod (gfc_expr *x, gfc_expr * *** 1007,1013 **** } ! try gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary, gfc_expr *dim) { --- 1032,1038 ---- } ! gfc_try gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary, gfc_expr *dim) { *************** gfc_check_eoshift (gfc_expr *array, gfc_ *** 1022,1038 **** if (scalar_check (shift, 2) == FAILURE) return FAILURE; } ! else { ! /* TODO: more weird restrictions on shift. */ } if (boundary != NULL) { if (same_type_check (array, 0, boundary, 2) == FAILURE) return FAILURE; ! /* TODO: more restrictions on boundary. */ } if (dim_check (dim, 4, true) == FAILURE) --- 1047,1091 ---- if (scalar_check (shift, 2) == FAILURE) return FAILURE; } ! else if (shift->rank != array->rank - 1 && shift->rank != 0) { ! gfc_error ("SHIFT argument at %L of EOSHIFT must have rank %d or be a " ! "scalar", &shift->where, array->rank - 1); ! return FAILURE; } + /* TODO: Add shape conformance check between array (w/o dimension dim) + and shift. */ + if (boundary != NULL) { if (same_type_check (array, 0, boundary, 2) == FAILURE) return FAILURE; ! if (array->rank == 1) ! { ! if (scalar_check (boundary, 2) == FAILURE) ! return FAILURE; ! } ! else if (boundary->rank != array->rank - 1 && boundary->rank != 0) ! { ! gfc_error ("BOUNDARY argument at %L of EOSHIFT must have rank %d or be " ! "a scalar", &boundary->where, array->rank - 1); ! return FAILURE; ! } ! ! if (shift->rank == boundary->rank) ! { ! int i; ! for (i = 0; i < shift->rank; i++) ! if (! identical_dimen_shape (shift, i, boundary, i)) ! { ! gfc_error ("Different shape in dimension %d for SHIFT and " ! "BOUNDARY arguments of EOSHIFT at %L", shift->rank, ! &boundary->where); ! return FAILURE; ! } ! } } if (dim_check (dim, 4, true) == FAILURE) *************** gfc_check_eoshift (gfc_expr *array, gfc_ *** 1044,1050 **** /* A single complex argument. */ ! try gfc_check_fn_c (gfc_expr *a) { if (type_check (a, 0, BT_COMPLEX) == FAILURE) --- 1097,1103 ---- /* A single complex argument. */ ! gfc_try gfc_check_fn_c (gfc_expr *a) { if (type_check (a, 0, BT_COMPLEX) == FAILURE) *************** gfc_check_fn_c (gfc_expr *a) *** 1056,1062 **** /* A single real argument. */ ! try gfc_check_fn_r (gfc_expr *a) { if (type_check (a, 0, BT_REAL) == FAILURE) --- 1109,1115 ---- /* A single real argument. */ ! gfc_try gfc_check_fn_r (gfc_expr *a) { if (type_check (a, 0, BT_REAL) == FAILURE) *************** gfc_check_fn_r (gfc_expr *a) *** 1067,1073 **** /* A single double argument. */ ! try gfc_check_fn_d (gfc_expr *a) { if (double_check (a, 0) == FAILURE) --- 1120,1126 ---- /* A single double argument. */ ! gfc_try gfc_check_fn_d (gfc_expr *a) { if (double_check (a, 0) == FAILURE) *************** gfc_check_fn_d (gfc_expr *a) *** 1078,1084 **** /* A single real or complex argument. */ ! try gfc_check_fn_rc (gfc_expr *a) { if (real_or_complex_check (a, 0) == FAILURE) --- 1131,1137 ---- /* A single real or complex argument. */ ! gfc_try gfc_check_fn_rc (gfc_expr *a) { if (real_or_complex_check (a, 0) == FAILURE) *************** gfc_check_fn_rc (gfc_expr *a) *** 1088,1094 **** } ! try gfc_check_fnum (gfc_expr *unit) { if (type_check (unit, 0, BT_INTEGER) == FAILURE) --- 1141,1147 ---- } ! gfc_try gfc_check_fnum (gfc_expr *unit) { if (type_check (unit, 0, BT_INTEGER) == FAILURE) *************** gfc_check_fnum (gfc_expr *unit) *** 1101,1107 **** } ! try gfc_check_huge (gfc_expr *x) { if (int_or_real_check (x, 0) == FAILURE) --- 1154,1160 ---- } ! gfc_try gfc_check_huge (gfc_expr *x) { if (int_or_real_check (x, 0) == FAILURE) *************** gfc_check_huge (gfc_expr *x) *** 1111,1119 **** } /* Check that the single argument is an integer. */ ! try gfc_check_i (gfc_expr *i) { if (type_check (i, 0, BT_INTEGER) == FAILURE) --- 1164,1184 ---- } + gfc_try + gfc_check_hypot (gfc_expr *x, gfc_expr *y) + { + if (type_check (x, 0, BT_REAL) == FAILURE) + return FAILURE; + if (same_type_check (x, 0, y, 1) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + /* Check that the single argument is an integer. */ ! gfc_try gfc_check_i (gfc_expr *i) { if (type_check (i, 0, BT_INTEGER) == FAILURE) *************** gfc_check_i (gfc_expr *i) *** 1123,1129 **** } ! try gfc_check_iand (gfc_expr *i, gfc_expr *j) { if (type_check (i, 0, BT_INTEGER) == FAILURE) --- 1188,1194 ---- } ! gfc_try gfc_check_iand (gfc_expr *i, gfc_expr *j) { if (type_check (i, 0, BT_INTEGER) == FAILURE) *************** gfc_check_iand (gfc_expr *i, gfc_expr *j *** 1143,1149 **** } ! try gfc_check_ibclr (gfc_expr *i, gfc_expr *pos) { if (type_check (i, 0, BT_INTEGER) == FAILURE) --- 1208,1214 ---- } ! gfc_try gfc_check_ibclr (gfc_expr *i, gfc_expr *pos) { if (type_check (i, 0, BT_INTEGER) == FAILURE) *************** gfc_check_ibclr (gfc_expr *i, gfc_expr * *** 1156,1162 **** } ! try gfc_check_ibits (gfc_expr *i, gfc_expr *pos, gfc_expr *len) { if (type_check (i, 0, BT_INTEGER) == FAILURE) --- 1221,1227 ---- } ! gfc_try gfc_check_ibits (gfc_expr *i, gfc_expr *pos, gfc_expr *len) { if (type_check (i, 0, BT_INTEGER) == FAILURE) *************** gfc_check_ibits (gfc_expr *i, gfc_expr * *** 1172,1178 **** } ! try gfc_check_ibset (gfc_expr *i, gfc_expr *pos) { if (type_check (i, 0, BT_INTEGER) == FAILURE) --- 1237,1243 ---- } ! gfc_try gfc_check_ibset (gfc_expr *i, gfc_expr *pos) { if (type_check (i, 0, BT_INTEGER) == FAILURE) *************** gfc_check_ibset (gfc_expr *i, gfc_expr * *** 1185,1191 **** } ! try gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind) { int i; --- 1250,1256 ---- } ! gfc_try gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind) { int i; *************** gfc_check_ichar_iachar (gfc_expr *c, gfc *** 1256,1262 **** } ! try gfc_check_idnint (gfc_expr *a) { if (double_check (a, 0) == FAILURE) --- 1321,1327 ---- } ! gfc_try gfc_check_idnint (gfc_expr *a) { if (double_check (a, 0) == FAILURE) *************** gfc_check_idnint (gfc_expr *a) *** 1266,1272 **** } ! try gfc_check_ieor (gfc_expr *i, gfc_expr *j) { if (type_check (i, 0, BT_INTEGER) == FAILURE) --- 1331,1337 ---- } ! gfc_try gfc_check_ieor (gfc_expr *i, gfc_expr *j) { if (type_check (i, 0, BT_INTEGER) == FAILURE) *************** gfc_check_ieor (gfc_expr *i, gfc_expr *j *** 1286,1292 **** } ! try gfc_check_index (gfc_expr *string, gfc_expr *substring, gfc_expr *back, gfc_expr *kind) { --- 1351,1357 ---- } ! gfc_try gfc_check_index (gfc_expr *string, gfc_expr *substring, gfc_expr *back, gfc_expr *kind) { *************** gfc_check_index (gfc_expr *string, gfc_e *** 1317,1323 **** } ! try gfc_check_int (gfc_expr *x, gfc_expr *kind) { if (numeric_check (x, 0) == FAILURE) --- 1382,1388 ---- } ! gfc_try gfc_check_int (gfc_expr *x, gfc_expr *kind) { if (numeric_check (x, 0) == FAILURE) *************** gfc_check_int (gfc_expr *x, gfc_expr *ki *** 1330,1336 **** } ! try gfc_check_intconv (gfc_expr *x) { if (numeric_check (x, 0) == FAILURE) --- 1395,1401 ---- } ! gfc_try gfc_check_intconv (gfc_expr *x) { if (numeric_check (x, 0) == FAILURE) *************** gfc_check_intconv (gfc_expr *x) *** 1340,1346 **** } ! try gfc_check_ior (gfc_expr *i, gfc_expr *j) { if (type_check (i, 0, BT_INTEGER) == FAILURE) --- 1405,1411 ---- } ! gfc_try gfc_check_ior (gfc_expr *i, gfc_expr *j) { if (type_check (i, 0, BT_INTEGER) == FAILURE) *************** gfc_check_ior (gfc_expr *i, gfc_expr *j) *** 1360,1366 **** } ! try gfc_check_ishft (gfc_expr *i, gfc_expr *shift) { if (type_check (i, 0, BT_INTEGER) == FAILURE --- 1425,1431 ---- } ! gfc_try gfc_check_ishft (gfc_expr *i, gfc_expr *shift) { if (type_check (i, 0, BT_INTEGER) == FAILURE *************** gfc_check_ishft (gfc_expr *i, gfc_expr * *** 1371,1377 **** } ! try gfc_check_ishftc (gfc_expr *i, gfc_expr *shift, gfc_expr *size) { if (type_check (i, 0, BT_INTEGER) == FAILURE --- 1436,1442 ---- } ! gfc_try gfc_check_ishftc (gfc_expr *i, gfc_expr *shift, gfc_expr *size) { if (type_check (i, 0, BT_INTEGER) == FAILURE *************** gfc_check_ishftc (gfc_expr *i, gfc_expr *** 1385,1391 **** } ! try gfc_check_kill (gfc_expr *pid, gfc_expr *sig) { if (type_check (pid, 0, BT_INTEGER) == FAILURE) --- 1450,1456 ---- } ! gfc_try gfc_check_kill (gfc_expr *pid, gfc_expr *sig) { if (type_check (pid, 0, BT_INTEGER) == FAILURE) *************** gfc_check_kill (gfc_expr *pid, gfc_expr *** 1398,1404 **** } ! try gfc_check_kill_sub (gfc_expr *pid, gfc_expr *sig, gfc_expr *status) { if (type_check (pid, 0, BT_INTEGER) == FAILURE) --- 1463,1469 ---- } ! gfc_try gfc_check_kill_sub (gfc_expr *pid, gfc_expr *sig, gfc_expr *status) { if (type_check (pid, 0, BT_INTEGER) == FAILURE) *************** gfc_check_kill_sub (gfc_expr *pid, gfc_e *** 1426,1432 **** } ! try gfc_check_kind (gfc_expr *x) { if (x->ts.type == BT_DERIVED) --- 1491,1497 ---- } ! gfc_try gfc_check_kind (gfc_expr *x) { if (x->ts.type == BT_DERIVED) *************** gfc_check_kind (gfc_expr *x) *** 1441,1447 **** } ! try gfc_check_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) { if (array_check (array, 0) == FAILURE) --- 1506,1512 ---- } ! gfc_try gfc_check_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) { if (array_check (array, 0) == FAILURE) *************** gfc_check_lbound (gfc_expr *array, gfc_e *** 1467,1473 **** } ! try gfc_check_len_lentrim (gfc_expr *s, gfc_expr *kind) { if (type_check (s, 0, BT_CHARACTER) == FAILURE) --- 1532,1538 ---- } ! gfc_try gfc_check_len_lentrim (gfc_expr *s, gfc_expr *kind) { if (type_check (s, 0, BT_CHARACTER) == FAILURE) *************** gfc_check_len_lentrim (gfc_expr *s, gfc_ *** 1484,1510 **** } ! try gfc_check_link (gfc_expr *path1, gfc_expr *path2) { if (type_check (path1, 0, BT_CHARACTER) == FAILURE) return FAILURE; if (type_check (path2, 1, BT_CHARACTER) == FAILURE) return FAILURE; return SUCCESS; } ! try gfc_check_link_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status) { if (type_check (path1, 0, BT_CHARACTER) == FAILURE) return FAILURE; if (type_check (path2, 1, BT_CHARACTER) == FAILURE) return FAILURE; if (status == NULL) return SUCCESS; --- 1549,1600 ---- } ! gfc_try ! gfc_check_lge_lgt_lle_llt (gfc_expr *a, gfc_expr *b) ! { ! if (type_check (a, 0, BT_CHARACTER) == FAILURE) ! return FAILURE; ! if (kind_value_check (a, 0, gfc_default_character_kind) == FAILURE) ! return FAILURE; ! ! if (type_check (b, 1, BT_CHARACTER) == FAILURE) ! return FAILURE; ! if (kind_value_check (b, 1, gfc_default_character_kind) == FAILURE) ! return FAILURE; ! ! return SUCCESS; ! } ! ! ! gfc_try gfc_check_link (gfc_expr *path1, gfc_expr *path2) { if (type_check (path1, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (type_check (path2, 1, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE) + return FAILURE; return SUCCESS; } ! gfc_try gfc_check_link_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status) { if (type_check (path1, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (type_check (path2, 1, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (path2, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (status == NULL) return SUCCESS; *************** gfc_check_link_sub (gfc_expr *path1, gfc *** 1519,1552 **** } ! try gfc_check_loc (gfc_expr *expr) { return variable_check (expr, 0); } ! try gfc_check_symlnk (gfc_expr *path1, gfc_expr *path2) { if (type_check (path1, 0, BT_CHARACTER) == FAILURE) return FAILURE; if (type_check (path2, 1, BT_CHARACTER) == FAILURE) return FAILURE; return SUCCESS; } ! try gfc_check_symlnk_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status) { if (type_check (path1, 0, BT_CHARACTER) == FAILURE) return FAILURE; if (type_check (path2, 1, BT_CHARACTER) == FAILURE) return FAILURE; if (status == NULL) return SUCCESS; --- 1609,1650 ---- } ! gfc_try gfc_check_loc (gfc_expr *expr) { return variable_check (expr, 0); } ! gfc_try gfc_check_symlnk (gfc_expr *path1, gfc_expr *path2) { if (type_check (path1, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (type_check (path2, 1, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE) + return FAILURE; return SUCCESS; } ! gfc_try gfc_check_symlnk_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status) { if (type_check (path1, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (type_check (path2, 1, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE) + return FAILURE; if (status == NULL) return SUCCESS; *************** gfc_check_symlnk_sub (gfc_expr *path1, g *** 1561,1567 **** } ! try gfc_check_logical (gfc_expr *a, gfc_expr *kind) { if (type_check (a, 0, BT_LOGICAL) == FAILURE) --- 1659,1665 ---- } ! gfc_try gfc_check_logical (gfc_expr *a, gfc_expr *kind) { if (type_check (a, 0, BT_LOGICAL) == FAILURE) *************** gfc_check_logical (gfc_expr *a, gfc_expr *** 1575,1581 **** /* Min/max family. */ ! static try min_max_args (gfc_actual_arglist *arg) { if (arg == NULL || arg->next == NULL) --- 1673,1679 ---- /* Min/max family. */ ! static gfc_try min_max_args (gfc_actual_arglist *arg) { if (arg == NULL || arg->next == NULL) *************** min_max_args (gfc_actual_arglist *arg) *** 1589,1595 **** } ! static try check_rest (bt type, int kind, gfc_actual_arglist *arglist) { gfc_actual_arglist *arg, *tmp; --- 1687,1693 ---- } ! static gfc_try check_rest (bt type, int kind, gfc_actual_arglist *arglist) { gfc_actual_arglist *arg, *tmp; *************** check_rest (bt type, int kind, gfc_actua *** 1634,1640 **** } ! try gfc_check_min_max (gfc_actual_arglist *arg) { gfc_expr *x; --- 1732,1738 ---- } ! gfc_try gfc_check_min_max (gfc_actual_arglist *arg) { gfc_expr *x; *************** gfc_check_min_max (gfc_actual_arglist *a *** 1662,1682 **** } ! try gfc_check_min_max_integer (gfc_actual_arglist *arg) { return check_rest (BT_INTEGER, gfc_default_integer_kind, arg); } ! try gfc_check_min_max_real (gfc_actual_arglist *arg) { return check_rest (BT_REAL, gfc_default_real_kind, arg); } ! try gfc_check_min_max_double (gfc_actual_arglist *arg) { return check_rest (BT_REAL, gfc_default_double_kind, arg); --- 1760,1780 ---- } ! gfc_try gfc_check_min_max_integer (gfc_actual_arglist *arg) { return check_rest (BT_INTEGER, gfc_default_integer_kind, arg); } ! gfc_try gfc_check_min_max_real (gfc_actual_arglist *arg) { return check_rest (BT_REAL, gfc_default_real_kind, arg); } ! gfc_try gfc_check_min_max_double (gfc_actual_arglist *arg) { return check_rest (BT_REAL, gfc_default_double_kind, arg); *************** gfc_check_min_max_double (gfc_actual_arg *** 1685,1691 **** /* End of min/max family. */ ! try gfc_check_malloc (gfc_expr *size) { if (type_check (size, 0, BT_INTEGER) == FAILURE) --- 1783,1789 ---- /* End of min/max family. */ ! gfc_try gfc_check_malloc (gfc_expr *size) { if (type_check (size, 0, BT_INTEGER) == FAILURE) *************** gfc_check_malloc (gfc_expr *size) *** 1698,1707 **** } ! try gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) { ! if ((matrix_a->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_b->ts)) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric " "or LOGICAL", gfc_current_intrinsic_arg[0], --- 1796,1805 ---- } ! gfc_try gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) { ! if ((matrix_a->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_a->ts)) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric " "or LOGICAL", gfc_current_intrinsic_arg[0], *************** gfc_check_matmul (gfc_expr *matrix_a, gf *** 1709,1715 **** return FAILURE; } ! if ((matrix_b->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_a->ts)) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric " "or LOGICAL", gfc_current_intrinsic_arg[1], --- 1807,1813 ---- return FAILURE; } ! if ((matrix_b->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_b->ts)) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric " "or LOGICAL", gfc_current_intrinsic_arg[1], *************** gfc_check_matmul (gfc_expr *matrix_a, gf *** 1717,1722 **** --- 1815,1829 ---- return FAILURE; } + if ((matrix_a->ts.type == BT_LOGICAL && gfc_numeric_ts (&matrix_b->ts)) + || (gfc_numeric_ts (&matrix_a->ts) && matrix_b->ts.type == BT_LOGICAL)) + { + gfc_error ("Argument types of '%s' intrinsic at %L must match (%s/%s)", + gfc_current_intrinsic, &matrix_a->where, + gfc_typename(&matrix_a->ts), gfc_typename(&matrix_b->ts)); + return FAILURE; + } + switch (matrix_a->rank) { case 1: *************** gfc_check_matmul (gfc_expr *matrix_a, gf *** 1777,1783 **** I.e. in the case of minloc(array,mask), mask will be in the second position of the argument list and we'll have to fix that up. */ ! try gfc_check_minloc_maxloc (gfc_actual_arglist *ap) { gfc_expr *a, *m, *d; --- 1884,1890 ---- I.e. in the case of minloc(array,mask), mask will be in the second position of the argument list and we'll have to fix that up. */ ! gfc_try gfc_check_minloc_maxloc (gfc_actual_arglist *ap) { gfc_expr *a, *m, *d; *************** gfc_check_minloc_maxloc (gfc_actual_argl *** 1836,1842 **** I.e. in the case of minval(array,mask), mask will be in the second position of the argument list and we'll have to fix that up. */ ! static try check_reduction (gfc_actual_arglist *ap) { gfc_expr *a, *m, *d; --- 1943,1949 ---- I.e. in the case of minval(array,mask), mask will be in the second position of the argument list and we'll have to fix that up. */ ! static gfc_try check_reduction (gfc_actual_arglist *ap) { gfc_expr *a, *m, *d; *************** check_reduction (gfc_actual_arglist *ap) *** 1877,1883 **** } ! try gfc_check_minval_maxval (gfc_actual_arglist *ap) { if (int_or_real_check (ap->expr, 0) == FAILURE --- 1984,1990 ---- } ! gfc_try gfc_check_minval_maxval (gfc_actual_arglist *ap) { if (int_or_real_check (ap->expr, 0) == FAILURE *************** gfc_check_minval_maxval (gfc_actual_argl *** 1888,1894 **** } ! try gfc_check_product_sum (gfc_actual_arglist *ap) { if (numeric_check (ap->expr, 0) == FAILURE --- 1995,2001 ---- } ! gfc_try gfc_check_product_sum (gfc_actual_arglist *ap) { if (numeric_check (ap->expr, 0) == FAILURE *************** gfc_check_product_sum (gfc_actual_arglis *** 1899,1905 **** } ! try gfc_check_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask) { if (same_type_check (tsource, 0, fsource, 1) == FAILURE) --- 2006,2012 ---- } ! gfc_try gfc_check_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask) { if (same_type_check (tsource, 0, fsource, 1) == FAILURE) *************** gfc_check_merge (gfc_expr *tsource, gfc_ *** 1909,1921 **** return FAILURE; if (tsource->ts.type == BT_CHARACTER) ! return check_same_strlen (tsource, fsource, "MERGE"); return SUCCESS; } ! try gfc_check_move_alloc (gfc_expr *from, gfc_expr *to) { symbol_attribute attr; --- 2016,2028 ---- return FAILURE; if (tsource->ts.type == BT_CHARACTER) ! return gfc_check_same_strlen (tsource, fsource, "MERGE intrinsic"); return SUCCESS; } ! gfc_try gfc_check_move_alloc (gfc_expr *from, gfc_expr *to) { symbol_attribute attr; *************** gfc_check_move_alloc (gfc_expr *from, gf *** 1975,1981 **** } ! try gfc_check_nearest (gfc_expr *x, gfc_expr *s) { if (type_check (x, 0, BT_REAL) == FAILURE) --- 2082,2088 ---- } ! gfc_try gfc_check_nearest (gfc_expr *x, gfc_expr *s) { if (type_check (x, 0, BT_REAL) == FAILURE) *************** gfc_check_nearest (gfc_expr *x, gfc_expr *** 1988,1994 **** } ! try gfc_check_new_line (gfc_expr *a) { if (type_check (a, 0, BT_CHARACTER) == FAILURE) --- 2095,2101 ---- } ! gfc_try gfc_check_new_line (gfc_expr *a) { if (type_check (a, 0, BT_CHARACTER) == FAILURE) *************** gfc_check_new_line (gfc_expr *a) *** 1998,2004 **** } ! try gfc_check_null (gfc_expr *mold) { symbol_attribute attr; --- 2105,2111 ---- } ! gfc_try gfc_check_null (gfc_expr *mold) { symbol_attribute attr; *************** gfc_check_null (gfc_expr *mold) *** 2011,2017 **** attr = gfc_variable_attr (mold, NULL); ! if (!attr.pointer) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER", gfc_current_intrinsic_arg[0], --- 2118,2124 ---- attr = gfc_variable_attr (mold, NULL); ! if (!attr.pointer && !attr.proc_pointer) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER", gfc_current_intrinsic_arg[0], *************** gfc_check_null (gfc_expr *mold) *** 2023,2029 **** } ! try gfc_check_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector) { char buffer[80]; --- 2130,2136 ---- } ! gfc_try gfc_check_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector) { char buffer[80]; *************** gfc_check_pack (gfc_expr *array, gfc_exp *** 2055,2061 **** } ! try gfc_check_precision (gfc_expr *x) { if (x->ts.type != BT_REAL && x->ts.type != BT_COMPLEX) --- 2162,2168 ---- } ! gfc_try gfc_check_precision (gfc_expr *x) { if (x->ts.type != BT_REAL && x->ts.type != BT_COMPLEX) *************** gfc_check_precision (gfc_expr *x) *** 2070,2076 **** } ! try gfc_check_present (gfc_expr *a) { gfc_symbol *sym; --- 2177,2183 ---- } ! gfc_try gfc_check_present (gfc_expr *a) { gfc_symbol *sym; *************** gfc_check_present (gfc_expr *a) *** 2115,2121 **** } ! try gfc_check_radix (gfc_expr *x) { if (int_or_real_check (x, 0) == FAILURE) --- 2222,2228 ---- } ! gfc_try gfc_check_radix (gfc_expr *x) { if (int_or_real_check (x, 0) == FAILURE) *************** gfc_check_radix (gfc_expr *x) *** 2125,2131 **** } ! try gfc_check_range (gfc_expr *x) { if (numeric_check (x, 0) == FAILURE) --- 2232,2238 ---- } ! gfc_try gfc_check_range (gfc_expr *x) { if (numeric_check (x, 0) == FAILURE) *************** gfc_check_range (gfc_expr *x) *** 2136,2142 **** /* real, float, sngl. */ ! try gfc_check_real (gfc_expr *a, gfc_expr *kind) { if (numeric_check (a, 0) == FAILURE) --- 2243,2249 ---- /* real, float, sngl. */ ! gfc_try gfc_check_real (gfc_expr *a, gfc_expr *kind) { if (numeric_check (a, 0) == FAILURE) *************** gfc_check_real (gfc_expr *a, gfc_expr *k *** 2149,2175 **** } ! try gfc_check_rename (gfc_expr *path1, gfc_expr *path2) { if (type_check (path1, 0, BT_CHARACTER) == FAILURE) return FAILURE; if (type_check (path2, 1, BT_CHARACTER) == FAILURE) return FAILURE; return SUCCESS; } ! try gfc_check_rename_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status) { if (type_check (path1, 0, BT_CHARACTER) == FAILURE) return FAILURE; if (type_check (path2, 1, BT_CHARACTER) == FAILURE) return FAILURE; if (status == NULL) return SUCCESS; --- 2256,2290 ---- } ! gfc_try gfc_check_rename (gfc_expr *path1, gfc_expr *path2) { if (type_check (path1, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (type_check (path2, 1, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE) + return FAILURE; return SUCCESS; } ! gfc_try gfc_check_rename_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status) { if (type_check (path1, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (type_check (path2, 1, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE) + return FAILURE; if (status == NULL) return SUCCESS; *************** gfc_check_rename_sub (gfc_expr *path1, g *** 2184,2190 **** } ! try gfc_check_repeat (gfc_expr *x, gfc_expr *y) { if (type_check (x, 0, BT_CHARACTER) == FAILURE) --- 2299,2305 ---- } ! gfc_try gfc_check_repeat (gfc_expr *x, gfc_expr *y) { if (type_check (x, 0, BT_CHARACTER) == FAILURE) *************** gfc_check_repeat (gfc_expr *x, gfc_expr *** 2203,2209 **** } ! try gfc_check_reshape (gfc_expr *source, gfc_expr *shape, gfc_expr *pad, gfc_expr *order) { --- 2318,2324 ---- } ! gfc_try gfc_check_reshape (gfc_expr *source, gfc_expr *shape, gfc_expr *pad, gfc_expr *order) { *************** gfc_check_reshape (gfc_expr *source, gfc *** 2282,2288 **** } ! try gfc_check_scale (gfc_expr *x, gfc_expr *i) { if (type_check (x, 0, BT_REAL) == FAILURE) --- 2397,2403 ---- } ! gfc_try gfc_check_scale (gfc_expr *x, gfc_expr *i) { if (type_check (x, 0, BT_REAL) == FAILURE) *************** gfc_check_scale (gfc_expr *x, gfc_expr * *** 2295,2301 **** } ! try gfc_check_scan (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind) { if (type_check (x, 0, BT_CHARACTER) == FAILURE) --- 2410,2416 ---- } ! gfc_try gfc_check_scan (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind) { if (type_check (x, 0, BT_CHARACTER) == FAILURE) *************** gfc_check_scan (gfc_expr *x, gfc_expr *y *** 2321,2327 **** } ! try gfc_check_secnds (gfc_expr *r) { if (type_check (r, 0, BT_REAL) == FAILURE) --- 2436,2442 ---- } ! gfc_try gfc_check_secnds (gfc_expr *r) { if (type_check (r, 0, BT_REAL) == FAILURE) *************** gfc_check_secnds (gfc_expr *r) *** 2337,2343 **** } ! try gfc_check_selected_int_kind (gfc_expr *r) { if (type_check (r, 0, BT_INTEGER) == FAILURE) --- 2452,2474 ---- } ! gfc_try ! gfc_check_selected_char_kind (gfc_expr *name) ! { ! if (type_check (name, 0, BT_CHARACTER) == FAILURE) ! return FAILURE; ! ! if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) ! return FAILURE; ! ! if (scalar_check (name, 0) == FAILURE) ! return FAILURE; ! ! return SUCCESS; ! } ! ! ! gfc_try gfc_check_selected_int_kind (gfc_expr *r) { if (type_check (r, 0, BT_INTEGER) == FAILURE) *************** gfc_check_selected_int_kind (gfc_expr *r *** 2350,2356 **** } ! try gfc_check_selected_real_kind (gfc_expr *p, gfc_expr *r) { if (p == NULL && r == NULL) --- 2481,2487 ---- } ! gfc_try gfc_check_selected_real_kind (gfc_expr *p, gfc_expr *r) { if (p == NULL && r == NULL) *************** gfc_check_selected_real_kind (gfc_expr * *** 2371,2377 **** } ! try gfc_check_set_exponent (gfc_expr *x, gfc_expr *i) { if (type_check (x, 0, BT_REAL) == FAILURE) --- 2502,2508 ---- } ! gfc_try gfc_check_set_exponent (gfc_expr *x, gfc_expr *i) { if (type_check (x, 0, BT_REAL) == FAILURE) *************** gfc_check_set_exponent (gfc_expr *x, gfc *** 2384,2390 **** } ! try gfc_check_shape (gfc_expr *source) { gfc_array_ref *ar; --- 2515,2521 ---- } ! gfc_try gfc_check_shape (gfc_expr *source) { gfc_array_ref *ar; *************** gfc_check_shape (gfc_expr *source) *** 2405,2411 **** } ! try gfc_check_sign (gfc_expr *a, gfc_expr *b) { if (int_or_real_check (a, 0) == FAILURE) --- 2536,2542 ---- } ! gfc_try gfc_check_sign (gfc_expr *a, gfc_expr *b) { if (int_or_real_check (a, 0) == FAILURE) *************** gfc_check_sign (gfc_expr *a, gfc_expr *b *** 2418,2424 **** } ! try gfc_check_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) { if (array_check (array, 0) == FAILURE) --- 2549,2555 ---- } ! gfc_try gfc_check_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) { if (array_check (array, 0) == FAILURE) *************** gfc_check_size (gfc_expr *array, gfc_exp *** 2445,2458 **** } ! try ! gfc_check_sizeof (gfc_expr *arg __attribute__((unused))) { return SUCCESS; } ! try gfc_check_sleep_sub (gfc_expr *seconds) { if (type_check (seconds, 0, BT_INTEGER) == FAILURE) --- 2576,2589 ---- } ! gfc_try ! gfc_check_sizeof (gfc_expr *arg ATTRIBUTE_UNUSED) { return SUCCESS; } ! gfc_try gfc_check_sleep_sub (gfc_expr *seconds) { if (type_check (seconds, 0, BT_INTEGER) == FAILURE) *************** gfc_check_sleep_sub (gfc_expr *seconds) *** 2465,2471 **** } ! try gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies) { if (source->rank >= GFC_MAX_DIMENSIONS) --- 2596,2602 ---- } ! gfc_try gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies) { if (source->rank >= GFC_MAX_DIMENSIONS) *************** gfc_check_spread (gfc_expr *source, gfc_ *** 2496,2502 **** /* Functions for checking FGETC, FPUTC, FGET and FPUT (subroutines and functions). */ ! try gfc_check_fgetputc_sub (gfc_expr *unit, gfc_expr *c, gfc_expr *status) { if (type_check (unit, 0, BT_INTEGER) == FAILURE) --- 2627,2633 ---- /* Functions for checking FGETC, FPUTC, FGET and FPUT (subroutines and functions). */ ! gfc_try gfc_check_fgetputc_sub (gfc_expr *unit, gfc_expr *c, gfc_expr *status) { if (type_check (unit, 0, BT_INTEGER) == FAILURE) *************** gfc_check_fgetputc_sub (gfc_expr *unit, *** 2507,2512 **** --- 2638,2645 ---- if (type_check (c, 1, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (c, 1, gfc_default_character_kind) == FAILURE) + return FAILURE; if (status == NULL) return SUCCESS; *************** gfc_check_fgetputc_sub (gfc_expr *unit, *** 2520,2537 **** } ! try gfc_check_fgetputc (gfc_expr *unit, gfc_expr *c) { return gfc_check_fgetputc_sub (unit, c, NULL); } ! try gfc_check_fgetput_sub (gfc_expr *c, gfc_expr *status) { if (type_check (c, 0, BT_CHARACTER) == FAILURE) return FAILURE; if (status == NULL) return SUCCESS; --- 2653,2672 ---- } ! gfc_try gfc_check_fgetputc (gfc_expr *unit, gfc_expr *c) { return gfc_check_fgetputc_sub (unit, c, NULL); } ! gfc_try gfc_check_fgetput_sub (gfc_expr *c, gfc_expr *status) { if (type_check (c, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (c, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (status == NULL) return SUCCESS; *************** gfc_check_fgetput_sub (gfc_expr *c, gfc_ *** 2545,2558 **** } ! try gfc_check_fgetput (gfc_expr *c) { return gfc_check_fgetput_sub (c, NULL); } ! try gfc_check_fseek_sub (gfc_expr *unit, gfc_expr *offset, gfc_expr *whence, gfc_expr *status) { if (type_check (unit, 0, BT_INTEGER) == FAILURE) --- 2680,2693 ---- } ! gfc_try gfc_check_fgetput (gfc_expr *c) { return gfc_check_fgetput_sub (c, NULL); } ! gfc_try gfc_check_fseek_sub (gfc_expr *unit, gfc_expr *offset, gfc_expr *whence, gfc_expr *status) { if (type_check (unit, 0, BT_INTEGER) == FAILURE) *************** gfc_check_fseek_sub (gfc_expr *unit, gfc *** 2590,2596 **** ! try gfc_check_fstat (gfc_expr *unit, gfc_expr *array) { if (type_check (unit, 0, BT_INTEGER) == FAILURE) --- 2725,2731 ---- ! gfc_try gfc_check_fstat (gfc_expr *unit, gfc_expr *array) { if (type_check (unit, 0, BT_INTEGER) == FAILURE) *************** gfc_check_fstat (gfc_expr *unit, gfc_exp *** 2610,2616 **** } ! try gfc_check_fstat_sub (gfc_expr *unit, gfc_expr *array, gfc_expr *status) { if (type_check (unit, 0, BT_INTEGER) == FAILURE) --- 2745,2751 ---- } ! gfc_try gfc_check_fstat_sub (gfc_expr *unit, gfc_expr *array, gfc_expr *status) { if (type_check (unit, 0, BT_INTEGER) == FAILURE) *************** gfc_check_fstat_sub (gfc_expr *unit, gfc *** 2640,2646 **** } ! try gfc_check_ftell (gfc_expr *unit) { if (type_check (unit, 0, BT_INTEGER) == FAILURE) --- 2775,2781 ---- } ! gfc_try gfc_check_ftell (gfc_expr *unit) { if (type_check (unit, 0, BT_INTEGER) == FAILURE) *************** gfc_check_ftell (gfc_expr *unit) *** 2653,2659 **** } ! try gfc_check_ftell_sub (gfc_expr *unit, gfc_expr *offset) { if (type_check (unit, 0, BT_INTEGER) == FAILURE) --- 2788,2794 ---- } ! gfc_try gfc_check_ftell_sub (gfc_expr *unit, gfc_expr *offset) { if (type_check (unit, 0, BT_INTEGER) == FAILURE) *************** gfc_check_ftell_sub (gfc_expr *unit, gfc *** 2672,2682 **** } ! try gfc_check_stat (gfc_expr *name, gfc_expr *array) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) return FAILURE; if (type_check (array, 1, BT_INTEGER) == FAILURE || kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE) --- 2807,2819 ---- } ! gfc_try gfc_check_stat (gfc_expr *name, gfc_expr *array) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (type_check (array, 1, BT_INTEGER) == FAILURE || kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE) *************** gfc_check_stat (gfc_expr *name, gfc_expr *** 2689,2699 **** } ! try gfc_check_stat_sub (gfc_expr *name, gfc_expr *array, gfc_expr *status) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) return FAILURE; if (type_check (array, 1, BT_INTEGER) == FAILURE || kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE) --- 2826,2838 ---- } ! gfc_try gfc_check_stat_sub (gfc_expr *name, gfc_expr *array, gfc_expr *status) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (type_check (array, 1, BT_INTEGER) == FAILURE || kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE) *************** gfc_check_stat_sub (gfc_expr *name, gfc_ *** 2716,2722 **** } ! try gfc_check_transfer (gfc_expr *source ATTRIBUTE_UNUSED, gfc_expr *mold ATTRIBUTE_UNUSED, gfc_expr *size) { --- 2855,2861 ---- } ! gfc_try gfc_check_transfer (gfc_expr *source ATTRIBUTE_UNUSED, gfc_expr *mold ATTRIBUTE_UNUSED, gfc_expr *size) { *************** gfc_check_transfer (gfc_expr *source ATT *** 2743,2749 **** } ! try gfc_check_transpose (gfc_expr *matrix) { if (rank_check (matrix, 0, 2) == FAILURE) --- 2882,2888 ---- } ! gfc_try gfc_check_transpose (gfc_expr *matrix) { if (rank_check (matrix, 0, 2) == FAILURE) *************** gfc_check_transpose (gfc_expr *matrix) *** 2753,2759 **** } ! try gfc_check_ubound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) { if (array_check (array, 0) == FAILURE) --- 2892,2898 ---- } ! gfc_try gfc_check_ubound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) { if (array_check (array, 0) == FAILURE) *************** gfc_check_ubound (gfc_expr *array, gfc_e *** 2779,2785 **** } ! try gfc_check_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field) { if (rank_check (vector, 0, 1) == FAILURE) --- 2918,2924 ---- } ! gfc_try gfc_check_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field) { if (rank_check (vector, 0, 1) == FAILURE) *************** gfc_check_unpack (gfc_expr *vector, gfc_ *** 2794,2804 **** if (same_type_check (vector, 0, field, 2) == FAILURE) return FAILURE; return SUCCESS; } ! try gfc_check_verify (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind) { if (type_check (x, 0, BT_CHARACTER) == FAILURE) --- 2933,2962 ---- if (same_type_check (vector, 0, field, 2) == FAILURE) return FAILURE; + if (mask->rank != field->rank && field->rank != 0) + { + gfc_error ("FIELD argument at %L of UNPACK must have the same rank as " + "MASK or be a scalar", &field->where); + return FAILURE; + } + + if (mask->rank == field->rank) + { + int i; + for (i = 0; i < field->rank; i++) + if (! identical_dimen_shape (mask, i, field, i)) + { + gfc_error ("Different shape in dimension %d for MASK and FIELD " + "arguments of UNPACK at %L", mask->rank, &field->where); + return FAILURE; + } + } + return SUCCESS; } ! gfc_try gfc_check_verify (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind) { if (type_check (x, 0, BT_CHARACTER) == FAILURE) *************** gfc_check_verify (gfc_expr *x, gfc_expr *** 2821,2827 **** } ! try gfc_check_trim (gfc_expr *x) { if (type_check (x, 0, BT_CHARACTER) == FAILURE) --- 2979,2985 ---- } ! gfc_try gfc_check_trim (gfc_expr *x) { if (type_check (x, 0, BT_CHARACTER) == FAILURE) *************** gfc_check_trim (gfc_expr *x) *** 2834,2840 **** } ! try gfc_check_ttynam (gfc_expr *unit) { if (scalar_check (unit, 0) == FAILURE) --- 2992,2998 ---- } ! gfc_try gfc_check_ttynam (gfc_expr *unit) { if (scalar_check (unit, 0) == FAILURE) *************** gfc_check_ttynam (gfc_expr *unit) *** 2850,2856 **** /* Common check function for the half a dozen intrinsics that have a single real argument. */ ! try gfc_check_x (gfc_expr *x) { if (type_check (x, 0, BT_REAL) == FAILURE) --- 3008,3014 ---- /* Common check function for the half a dozen intrinsics that have a single real argument. */ ! gfc_try gfc_check_x (gfc_expr *x) { if (type_check (x, 0, BT_REAL) == FAILURE) *************** gfc_check_x (gfc_expr *x) *** 2862,2868 **** /************* Check functions for intrinsic subroutines *************/ ! try gfc_check_cpu_time (gfc_expr *time) { if (scalar_check (time, 0) == FAILURE) --- 3020,3026 ---- /************* Check functions for intrinsic subroutines *************/ ! gfc_try gfc_check_cpu_time (gfc_expr *time) { if (scalar_check (time, 0) == FAILURE) *************** gfc_check_cpu_time (gfc_expr *time) *** 2878,2884 **** } ! try gfc_check_date_and_time (gfc_expr *date, gfc_expr *time, gfc_expr *zone, gfc_expr *values) { --- 3036,3042 ---- } ! gfc_try gfc_check_date_and_time (gfc_expr *date, gfc_expr *time, gfc_expr *zone, gfc_expr *values) { *************** gfc_check_date_and_time (gfc_expr *date, *** 2886,2891 **** --- 3044,3051 ---- { if (type_check (date, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (date, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (scalar_check (date, 0) == FAILURE) return FAILURE; if (variable_check (date, 0) == FAILURE) *************** gfc_check_date_and_time (gfc_expr *date, *** 2896,2901 **** --- 3056,3063 ---- { if (type_check (time, 1, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (time, 1, gfc_default_character_kind) == FAILURE) + return FAILURE; if (scalar_check (time, 1) == FAILURE) return FAILURE; if (variable_check (time, 1) == FAILURE) *************** gfc_check_date_and_time (gfc_expr *date, *** 2906,2911 **** --- 3068,3075 ---- { if (type_check (zone, 2, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (zone, 2, gfc_default_character_kind) == FAILURE) + return FAILURE; if (scalar_check (zone, 2) == FAILURE) return FAILURE; if (variable_check (zone, 2) == FAILURE) *************** gfc_check_date_and_time (gfc_expr *date, *** 2928,2934 **** } ! try gfc_check_mvbits (gfc_expr *from, gfc_expr *frompos, gfc_expr *len, gfc_expr *to, gfc_expr *topos) { --- 3092,3098 ---- } ! gfc_try gfc_check_mvbits (gfc_expr *from, gfc_expr *frompos, gfc_expr *len, gfc_expr *to, gfc_expr *topos) { *************** gfc_check_mvbits (gfc_expr *from, gfc_ex *** 2954,2960 **** } ! try gfc_check_random_number (gfc_expr *harvest) { if (type_check (harvest, 0, BT_REAL) == FAILURE) --- 3118,3124 ---- } ! gfc_try gfc_check_random_number (gfc_expr *harvest) { if (type_check (harvest, 0, BT_REAL) == FAILURE) *************** gfc_check_random_number (gfc_expr *harve *** 2967,2977 **** } ! try gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get) { ! unsigned int nargs = 0; locus *where = NULL; if (size != NULL) { --- 3131,3149 ---- } ! gfc_try gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get) { ! unsigned int nargs = 0, kiss_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; if (size != NULL) { *************** gfc_check_random_seed (gfc_expr *size, g *** 3012,3017 **** --- 3184,3196 ---- if (kind_value_check (put, 1, gfc_default_integer_kind) == FAILURE) return FAILURE; + + if (gfc_array_size (put, &put_size) == SUCCESS + && mpz_get_ui (put_size) < kiss_size) + gfc_error ("Size of '%s' argument of '%s' intrinsic at %L " + "too small (%i/%i)", + gfc_current_intrinsic_arg[1], gfc_current_intrinsic, where, + (int) mpz_get_ui (put_size), kiss_size); } if (get != NULL) *************** gfc_check_random_seed (gfc_expr *size, g *** 3037,3042 **** --- 3216,3228 ---- if (kind_value_check (get, 2, gfc_default_integer_kind) == FAILURE) return FAILURE; + + if (gfc_array_size (get, &get_size) == SUCCESS + && mpz_get_ui (get_size) < kiss_size) + gfc_error ("Size of '%s' argument of '%s' intrinsic at %L " + "too small (%i/%i)", + gfc_current_intrinsic_arg[2], gfc_current_intrinsic, where, + (int) mpz_get_ui (get_size), kiss_size); } /* RANDOM_SEED may not have more than one non-optional argument. */ *************** gfc_check_random_seed (gfc_expr *size, g *** 3047,3053 **** } ! try gfc_check_second_sub (gfc_expr *time) { if (scalar_check (time, 0) == FAILURE) --- 3233,3239 ---- } ! gfc_try gfc_check_second_sub (gfc_expr *time) { if (scalar_check (time, 0) == FAILURE) *************** gfc_check_second_sub (gfc_expr *time) *** 3066,3072 **** /* The arguments of SYSTEM_CLOCK are scalar, integer variables. Note, count, count_rate, and count_max are all optional arguments */ ! try gfc_check_system_clock (gfc_expr *count, gfc_expr *count_rate, gfc_expr *count_max) { --- 3252,3258 ---- /* The arguments of SYSTEM_CLOCK are scalar, integer variables. Note, count, count_rate, and count_max are all optional arguments */ ! gfc_try gfc_check_system_clock (gfc_expr *count, gfc_expr *count_rate, gfc_expr *count_max) { *************** gfc_check_system_clock (gfc_expr *count, *** 3123,3129 **** } ! try gfc_check_irand (gfc_expr *x) { if (x == NULL) --- 3309,3315 ---- } ! gfc_try gfc_check_irand (gfc_expr *x) { if (x == NULL) *************** gfc_check_irand (gfc_expr *x) *** 3142,3148 **** } ! try gfc_check_alarm_sub (gfc_expr *seconds, gfc_expr *handler, gfc_expr *status) { if (scalar_check (seconds, 0) == FAILURE) --- 3328,3334 ---- } ! gfc_try gfc_check_alarm_sub (gfc_expr *seconds, gfc_expr *handler, gfc_expr *status) { if (scalar_check (seconds, 0) == FAILURE) *************** gfc_check_alarm_sub (gfc_expr *seconds, *** 3178,3184 **** } ! try gfc_check_rand (gfc_expr *x) { if (x == NULL) --- 3364,3370 ---- } ! gfc_try gfc_check_rand (gfc_expr *x) { if (x == NULL) *************** gfc_check_rand (gfc_expr *x) *** 3197,3203 **** } ! try gfc_check_srand (gfc_expr *x) { if (scalar_check (x, 0) == FAILURE) --- 3383,3389 ---- } ! gfc_try gfc_check_srand (gfc_expr *x) { if (scalar_check (x, 0) == FAILURE) *************** gfc_check_srand (gfc_expr *x) *** 3213,3235 **** } ! try gfc_check_ctime_sub (gfc_expr *time, gfc_expr *result) { if (scalar_check (time, 0) == FAILURE) return FAILURE; - if (type_check (time, 0, BT_INTEGER) == FAILURE) return FAILURE; if (type_check (result, 1, BT_CHARACTER) == FAILURE) return FAILURE; return SUCCESS; } ! try gfc_check_dtime_etime (gfc_expr *x) { if (array_check (x, 0) == FAILURE) --- 3399,3422 ---- } ! gfc_try gfc_check_ctime_sub (gfc_expr *time, gfc_expr *result) { if (scalar_check (time, 0) == FAILURE) return FAILURE; if (type_check (time, 0, BT_INTEGER) == FAILURE) return FAILURE; if (type_check (result, 1, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (result, 1, gfc_default_character_kind) == FAILURE) + return FAILURE; return SUCCESS; } ! gfc_try gfc_check_dtime_etime (gfc_expr *x) { if (array_check (x, 0) == FAILURE) *************** gfc_check_dtime_etime (gfc_expr *x) *** 3251,3257 **** } ! try gfc_check_dtime_etime_sub (gfc_expr *values, gfc_expr *time) { if (array_check (values, 0) == FAILURE) --- 3438,3444 ---- } ! gfc_try gfc_check_dtime_etime_sub (gfc_expr *values, gfc_expr *time) { if (array_check (values, 0) == FAILURE) *************** gfc_check_dtime_etime_sub (gfc_expr *val *** 3282,3312 **** } ! try gfc_check_fdate_sub (gfc_expr *date) { if (type_check (date, 0, BT_CHARACTER) == FAILURE) return FAILURE; return SUCCESS; } ! try gfc_check_gerror (gfc_expr *msg) { if (type_check (msg, 0, BT_CHARACTER) == FAILURE) return FAILURE; return SUCCESS; } ! try gfc_check_getcwd_sub (gfc_expr *cwd, gfc_expr *status) { if (type_check (cwd, 0, BT_CHARACTER) == FAILURE) return FAILURE; if (status == NULL) return SUCCESS; --- 3469,3505 ---- } ! gfc_try gfc_check_fdate_sub (gfc_expr *date) { if (type_check (date, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (date, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; return SUCCESS; } ! gfc_try gfc_check_gerror (gfc_expr *msg) { if (type_check (msg, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (msg, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; return SUCCESS; } ! gfc_try gfc_check_getcwd_sub (gfc_expr *cwd, gfc_expr *status) { if (type_check (cwd, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (cwd, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (status == NULL) return SUCCESS; *************** gfc_check_getcwd_sub (gfc_expr *cwd, gfc *** 3321,3327 **** } ! try gfc_check_getarg (gfc_expr *pos, gfc_expr *value) { if (type_check (pos, 0, BT_INTEGER) == FAILURE) --- 3514,3520 ---- } ! gfc_try gfc_check_getarg (gfc_expr *pos, gfc_expr *value) { if (type_check (pos, 0, BT_INTEGER) == FAILURE) *************** gfc_check_getarg (gfc_expr *pos, gfc_exp *** 3338,3359 **** if (type_check (value, 1, BT_CHARACTER) == FAILURE) return FAILURE; return SUCCESS; } ! try gfc_check_getlog (gfc_expr *msg) { if (type_check (msg, 0, BT_CHARACTER) == FAILURE) return FAILURE; return SUCCESS; } ! try gfc_check_exit (gfc_expr *status) { if (status == NULL) --- 3531,3556 ---- if (type_check (value, 1, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (value, 1, gfc_default_character_kind) == FAILURE) + return FAILURE; return SUCCESS; } ! gfc_try gfc_check_getlog (gfc_expr *msg) { if (type_check (msg, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (msg, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; return SUCCESS; } ! gfc_try gfc_check_exit (gfc_expr *status) { if (status == NULL) *************** gfc_check_exit (gfc_expr *status) *** 3369,3375 **** } ! try gfc_check_flush (gfc_expr *unit) { if (unit == NULL) --- 3566,3572 ---- } ! gfc_try gfc_check_flush (gfc_expr *unit) { if (unit == NULL) *************** gfc_check_flush (gfc_expr *unit) *** 3385,3391 **** } ! try gfc_check_free (gfc_expr *i) { if (type_check (i, 0, BT_INTEGER) == FAILURE) --- 3582,3588 ---- } ! gfc_try gfc_check_free (gfc_expr *i) { if (type_check (i, 0, BT_INTEGER) == FAILURE) *************** gfc_check_free (gfc_expr *i) *** 3398,3418 **** } ! try gfc_check_hostnm (gfc_expr *name) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) return FAILURE; return SUCCESS; } ! try gfc_check_hostnm_sub (gfc_expr *name, gfc_expr *status) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) return FAILURE; if (status == NULL) return SUCCESS; --- 3595,3619 ---- } ! gfc_try gfc_check_hostnm (gfc_expr *name) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; return SUCCESS; } ! gfc_try gfc_check_hostnm_sub (gfc_expr *name, gfc_expr *status) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (status == NULL) return SUCCESS; *************** gfc_check_hostnm_sub (gfc_expr *name, gf *** 3427,3433 **** } ! try gfc_check_itime_idate (gfc_expr *values) { if (array_check (values, 0) == FAILURE) --- 3628,3634 ---- } ! gfc_try gfc_check_itime_idate (gfc_expr *values) { if (array_check (values, 0) == FAILURE) *************** gfc_check_itime_idate (gfc_expr *values) *** 3449,3455 **** } ! try gfc_check_ltime_gmtime (gfc_expr *time, gfc_expr *values) { if (type_check (time, 0, BT_INTEGER) == FAILURE) --- 3650,3656 ---- } ! gfc_try gfc_check_ltime_gmtime (gfc_expr *time, gfc_expr *values) { if (type_check (time, 0, BT_INTEGER) == FAILURE) *************** gfc_check_ltime_gmtime (gfc_expr *time, *** 3480,3486 **** } ! try gfc_check_ttynam_sub (gfc_expr *unit, gfc_expr *name) { if (scalar_check (unit, 0) == FAILURE) --- 3681,3687 ---- } ! gfc_try gfc_check_ttynam_sub (gfc_expr *unit, gfc_expr *name) { if (scalar_check (unit, 0) == FAILURE) *************** gfc_check_ttynam_sub (gfc_expr *unit, gf *** 3491,3502 **** if (type_check (name, 1, BT_CHARACTER) == FAILURE) return FAILURE; return SUCCESS; } ! try gfc_check_isatty (gfc_expr *unit) { if (unit == NULL) --- 3692,3705 ---- if (type_check (name, 1, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (name, 1, gfc_default_character_kind) == FAILURE) + return FAILURE; return SUCCESS; } ! gfc_try gfc_check_isatty (gfc_expr *unit) { if (unit == NULL) *************** gfc_check_isatty (gfc_expr *unit) *** 3512,3518 **** } ! try gfc_check_isnan (gfc_expr *x) { if (type_check (x, 0, BT_REAL) == FAILURE) --- 3715,3721 ---- } ! gfc_try gfc_check_isnan (gfc_expr *x) { if (type_check (x, 0, BT_REAL) == FAILURE) *************** gfc_check_isnan (gfc_expr *x) *** 3522,3538 **** } ! try gfc_check_perror (gfc_expr *string) { if (type_check (string, 0, BT_CHARACTER) == FAILURE) return FAILURE; return SUCCESS; } ! try gfc_check_umask (gfc_expr *mask) { if (type_check (mask, 0, BT_INTEGER) == FAILURE) --- 3725,3743 ---- } ! gfc_try gfc_check_perror (gfc_expr *string) { if (type_check (string, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (string, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; return SUCCESS; } ! gfc_try gfc_check_umask (gfc_expr *mask) { if (type_check (mask, 0, BT_INTEGER) == FAILURE) *************** gfc_check_umask (gfc_expr *mask) *** 3545,3551 **** } ! try gfc_check_umask_sub (gfc_expr *mask, gfc_expr *old) { if (type_check (mask, 0, BT_INTEGER) == FAILURE) --- 3750,3756 ---- } ! gfc_try gfc_check_umask_sub (gfc_expr *mask, gfc_expr *old) { if (type_check (mask, 0, BT_INTEGER) == FAILURE) *************** gfc_check_umask_sub (gfc_expr *mask, gfc *** 3567,3587 **** } ! try gfc_check_unlink (gfc_expr *name) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) return FAILURE; return SUCCESS; } ! try gfc_check_unlink_sub (gfc_expr *name, gfc_expr *status) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) return FAILURE; if (status == NULL) return SUCCESS; --- 3772,3796 ---- } ! gfc_try gfc_check_unlink (gfc_expr *name) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; return SUCCESS; } ! gfc_try gfc_check_unlink_sub (gfc_expr *name, gfc_expr *status) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (status == NULL) return SUCCESS; *************** gfc_check_unlink_sub (gfc_expr *name, gf *** 3596,3602 **** } ! try gfc_check_signal (gfc_expr *number, gfc_expr *handler) { if (scalar_check (number, 0) == FAILURE) --- 3805,3811 ---- } ! gfc_try gfc_check_signal (gfc_expr *number, gfc_expr *handler) { if (scalar_check (number, 0) == FAILURE) *************** gfc_check_signal (gfc_expr *number, gfc_ *** 3620,3626 **** } ! try gfc_check_signal_sub (gfc_expr *number, gfc_expr *handler, gfc_expr *status) { if (scalar_check (number, 0) == FAILURE) --- 3829,3835 ---- } ! gfc_try gfc_check_signal_sub (gfc_expr *number, gfc_expr *handler, gfc_expr *status) { if (scalar_check (number, 0) == FAILURE) *************** gfc_check_signal_sub (gfc_expr *number, *** 3653,3663 **** } ! try gfc_check_system_sub (gfc_expr *cmd, gfc_expr *status) { if (type_check (cmd, 0, BT_CHARACTER) == FAILURE) return FAILURE; if (scalar_check (status, 1) == FAILURE) return FAILURE; --- 3862,3874 ---- } ! gfc_try gfc_check_system_sub (gfc_expr *cmd, gfc_expr *status) { if (type_check (cmd, 0, BT_CHARACTER) == FAILURE) return FAILURE; + if (kind_value_check (cmd, 0, gfc_default_character_kind) == FAILURE) + return FAILURE; if (scalar_check (status, 1) == FAILURE) return FAILURE; *************** gfc_check_system_sub (gfc_expr *cmd, gfc *** 3673,3679 **** /* This is used for the GNU intrinsics AND, OR and XOR. */ ! try gfc_check_and (gfc_expr *i, gfc_expr *j) { if (i->ts.type != BT_INTEGER && i->ts.type != BT_LOGICAL) --- 3884,3890 ---- /* This is used for the GNU intrinsics AND, OR and XOR. */ ! gfc_try gfc_check_and (gfc_expr *i, gfc_expr *j) { if (i->ts.type != BT_INTEGER && i->ts.type != BT_LOGICAL) diff -Nrcpad gcc-4.3.3/gcc/fortran/convert.c gcc-4.4.0/gcc/fortran/convert.c *** gcc-4.3.3/gcc/fortran/convert.c Wed Aug 1 16:29:36 2007 --- gcc-4.4.0/gcc/fortran/convert.c Sun Feb 24 16:43:23 2008 *************** *** 1,5 **** /* Language-level data type conversion for GNU C. ! Copyright (C) 1987, 1988, 1991, 1998, 2002, 2007 Free Software Foundation, Inc. This file is part of GCC. --- 1,5 ---- /* Language-level data type conversion for GNU C. ! Copyright (C) 1987, 1988, 1991, 1998, 2002, 2007, 2008 Free Software Foundation, Inc. This file is part of GCC. *************** convert (tree type, tree expr) *** 89,95 **** return error_mark_node; } if (code == VOID_TYPE) ! return build1 (CONVERT_EXPR, type, e); #if 0 /* This is incorrect. A truncation can't be stripped this way. Extensions will be stripped by the use of get_unwidened. */ --- 89,95 ---- return error_mark_node; } if (code == VOID_TYPE) ! return fold_build1 (CONVERT_EXPR, type, e); #if 0 /* This is incorrect. A truncation can't be stripped this way. Extensions will be stripped by the use of get_unwidened. */ diff -Nrcpad gcc-4.3.3/gcc/fortran/cpp.c gcc-4.4.0/gcc/fortran/cpp.c *** gcc-4.3.3/gcc/fortran/cpp.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/gcc/fortran/cpp.c Tue Dec 9 19:25:55 2008 *************** *** 0 **** --- 1,1043 ---- + /* Copyright (C) 2008 Free Software Foundation, Inc. + + This file is part of GCC. + + GCC is free software; you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free + Software Foundation; either version 3, or (at your option) any later + version. + + GCC is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + + #include "config.h" + #include "system.h" + #include "coretypes.h" + #include "tm.h" + #include "tree.h" + #include "version.h" + #include "flags.h" + + + #include "options.h" + #include "gfortran.h" + #include "tm_p.h" /* Target prototypes. */ + #include "target.h" + #include "toplev.h" + #include "diagnostic.h" + + #include "../../libcpp/internal.h" + #include "cpp.h" + #include "incpath.h" + + #ifndef TARGET_OS_CPP_BUILTINS + # define TARGET_OS_CPP_BUILTINS() + #endif + + #ifndef TARGET_OBJFMT_CPP_BUILTINS + # define TARGET_OBJFMT_CPP_BUILTINS() + #endif + + + /* Holds switches parsed by gfc_cpp_handle_option (), but whose + handling is deferred to gfc_cpp_init (). */ + typedef struct + { + enum opt_code code; + const char *arg; + } + gfc_cpp_deferred_opt_t; + + + /* Defined and undefined macros being queued for output with -dU at + the next newline. */ + typedef struct gfc_cpp_macro_queue + { + struct gfc_cpp_macro_queue *next; /* Next macro in the list. */ + char *macro; /* The name of the macro if not + defined, the full definition if + defined. */ + } gfc_cpp_macro_queue; + static gfc_cpp_macro_queue *cpp_define_queue, *cpp_undefine_queue; + + struct + { + /* Argument of -cpp, implied by SPEC; + if NULL, preprocessing disabled. */ + const char *temporary_filename; + + const char *output_filename; /* -o */ + int preprocess_only; /* -E */ + int discard_comments; /* -C */ + int discard_comments_in_macro_exp; /* -CC */ + int print_include_names; /* -H */ + int no_line_commands; /* -P */ + char dump_macros; /* -d[DMNU] */ + int dump_includes; /* -dI */ + int working_directory; /* -fworking-directory */ + int no_predefined; /* -undef */ + int standard_include_paths; /* -nostdinc */ + int verbose; /* -v */ + + const char *multilib; /* -imultilib */ + const char *prefix; /* -iprefix */ + const char *sysroot; /* -isysroot */ + + /* Options whose handling needs to be deferred until the + appropriate cpp-objects are created: + -A predicate=answer + -D [=] + -U */ + gfc_cpp_deferred_opt_t *deferred_opt; + int deferred_opt_count; + } + gfc_cpp_option; + + /* Structures used with libcpp: */ + static cpp_options *cpp_option = NULL; + static cpp_reader *cpp_in = NULL; + + /* Defined in toplev.c. */ + extern const char *asm_file_name; + + + + + /* Encapsulates state used to convert a stream of cpp-tokens into + a text file. */ + static struct + { + FILE *outf; /* Stream to write to. */ + const cpp_token *prev; /* Previous token. */ + const cpp_token *source; /* Source token for spacing. */ + int src_line; /* Line number currently being written. */ + unsigned char printed; /* Nonzero if something output at line. */ + bool first_time; /* cb_file_change hasn't been called yet. */ + } print; + + /* General output routines. */ + static void scan_translation_unit (cpp_reader *); + static void scan_translation_unit_trad (cpp_reader *); + + /* Callback routines for the parser. Most of these are active only + in specific modes. */ + static void cb_file_change (cpp_reader *, const struct line_map *); + static void cb_line_change (cpp_reader *, const cpp_token *, int); + static void cb_define (cpp_reader *, source_location, cpp_hashnode *); + static void cb_undef (cpp_reader *, source_location, cpp_hashnode *); + static void cb_def_pragma (cpp_reader *, source_location); + static void cb_include (cpp_reader *, source_location, const unsigned char *, + const char *, int, const cpp_token **); + static void cb_ident (cpp_reader *, source_location, const cpp_string *); + static void cb_used_define (cpp_reader *, source_location, cpp_hashnode *); + static void cb_used_undef (cpp_reader *, source_location, cpp_hashnode *); + void pp_dir_change (cpp_reader *, const char *); + + static int dump_macro (cpp_reader *, cpp_hashnode *, void *); + static void dump_queued_macros (cpp_reader *); + + + static void + cpp_define_builtins (cpp_reader *pfile) + { + int major, minor, patchlevel; + + /* Initialize CPP built-ins; '1' corresponds to 'flag_hosted' + in C, defines __STDC_HOSTED__?! */ + cpp_init_builtins (pfile, 0); + + /* Initialize GFORTRAN specific builtins. + These are documented. */ + if (sscanf (BASEVER, "%d.%d.%d", &major, &minor, &patchlevel) != 3) + { + sscanf (BASEVER, "%d.%d", &major, &minor); + patchlevel = 0; + } + cpp_define_formatted (pfile, "__GNUC__=%d", major); + cpp_define_formatted (pfile, "__GNUC_MINOR__=%d", minor); + cpp_define_formatted (pfile, "__GNUC_PATCHLEVEL__=%d", patchlevel); + + cpp_define (pfile, "__GFORTRAN__=1"); + cpp_define (pfile, "_LANGUAGE_FORTRAN=1"); + + if (gfc_option.flag_openmp) + cpp_define (pfile, "_OPENMP=200805"); + + + /* More builtins that might be useful, but are not documented + (in no particular order). */ + cpp_define_formatted (pfile, "__VERSION__=\"%s\"", version_string); + + if (flag_pic) + { + cpp_define_formatted (pfile, "__pic__=%d", flag_pic); + cpp_define_formatted (pfile, "__PIC__=%d", flag_pic); + } + if (flag_pie) + { + cpp_define_formatted (pfile, "__pie__=%d", flag_pie); + cpp_define_formatted (pfile, "__PIE__=%d", flag_pie); + } + + if (optimize_size) + cpp_define (pfile, "__OPTIMIZE_SIZE__"); + if (optimize) + cpp_define (pfile, "__OPTIMIZE__"); + + if (fast_math_flags_set_p ()) + cpp_define (pfile, "__FAST_MATH__"); + if (flag_signaling_nans) + cpp_define (pfile, "__SUPPORT_SNAN__"); + + cpp_define_formatted (pfile, "__FINITE_MATH_ONLY__=%d", flag_finite_math_only); + + /* Definitions for LP64 model. */ + if (TYPE_PRECISION (long_integer_type_node) == 64 + && POINTER_SIZE == 64 + && TYPE_PRECISION (integer_type_node) == 32) + { + cpp_define (pfile, "_LP64"); + cpp_define (pfile, "__LP64__"); + } + + /* Define NAME with value TYPE size_unit. + The C-side also defines __SIZEOF_WCHAR_T__, __SIZEOF_WINT_T__ + __SIZEOF_PTRDIFF_T__, however, fortran seems to lack the + appropriate type nodes. */ + + #define define_type_sizeof(NAME, TYPE) \ + cpp_define_formatted (pfile, NAME"="HOST_WIDE_INT_PRINT_DEC, \ + tree_low_cst (TYPE_SIZE_UNIT (TYPE), 1)) + + define_type_sizeof ("__SIZEOF_INT__", integer_type_node); + define_type_sizeof ("__SIZEOF_LONG__", long_integer_type_node); + define_type_sizeof ("__SIZEOF_LONG_LONG__", long_long_integer_type_node); + define_type_sizeof ("__SIZEOF_SHORT__", short_integer_type_node); + define_type_sizeof ("__SIZEOF_FLOAT__", float_type_node); + define_type_sizeof ("__SIZEOF_DOUBLE__", double_type_node); + define_type_sizeof ("__SIZEOF_LONG_DOUBLE__", long_double_type_node); + define_type_sizeof ("__SIZEOF_SIZE_T__", size_type_node); + + #undef define_type_sizeof + + /* The defines below are necessary for the TARGET_* macros. + + FIXME: Note that builtin_define_std() actually is a function + in c-cppbuiltin.c which uses flags undefined for Fortran. + Let's skip this for now. If needed, one needs to look into it + once more. */ + + # define builtin_define(TXT) cpp_define (pfile, TXT) + # define builtin_define_std(TXT) + # define builtin_assert(TXT) cpp_assert (pfile, TXT) + + /* FIXME: Pandora's Box + Using the macros below results in multiple breakages: + - mingw will fail to compile this file as dependent macros + assume to be used in c-cppbuiltin.c only. Further, they use + flags only valid/defined in C (same as noted above). + [config/i386/mingw32.h, config/i386/cygming.h] + - other platforms (not as popular) break similarly + [grep for 'builtin_define_with_int_value' in gcc/config/] + + TARGET_CPU_CPP_BUILTINS (); + TARGET_OS_CPP_BUILTINS (); + TARGET_OBJFMT_CPP_BUILTINS (); */ + + #undef builtin_define + #undef builtin_define_std + #undef builtin_assert + } + + bool + gfc_cpp_enabled (void) + { + return gfc_cpp_option.temporary_filename != NULL; + } + + bool + gfc_cpp_preprocess_only (void) + { + return gfc_cpp_option.preprocess_only; + } + + const char * + gfc_cpp_temporary_file (void) + { + return gfc_cpp_option.temporary_filename; + } + + void + gfc_cpp_init_options (unsigned int argc, + const char **argv ATTRIBUTE_UNUSED) + { + /* Do not create any objects from libcpp here. If no + preprocessing is requested, this would be wasted + time and effort. + + See gfc_cpp_post_options() instead. */ + + gfc_cpp_option.temporary_filename = NULL; + gfc_cpp_option.output_filename = NULL; + gfc_cpp_option.preprocess_only = 0; + gfc_cpp_option.discard_comments = 1; + gfc_cpp_option.discard_comments_in_macro_exp = 1; + gfc_cpp_option.print_include_names = 0; + gfc_cpp_option.no_line_commands = 0; + gfc_cpp_option.dump_macros = '\0'; + gfc_cpp_option.dump_includes = 0; + gfc_cpp_option.working_directory = -1; + gfc_cpp_option.no_predefined = 0; + gfc_cpp_option.standard_include_paths = 1; + gfc_cpp_option.verbose = 0; + + gfc_cpp_option.multilib = NULL; + gfc_cpp_option.prefix = NULL; + gfc_cpp_option.sysroot = NULL; + + gfc_cpp_option.deferred_opt = XNEWVEC (gfc_cpp_deferred_opt_t, argc); + gfc_cpp_option.deferred_opt_count = 0; + } + + int + gfc_cpp_handle_option (size_t scode, const char *arg, int value ATTRIBUTE_UNUSED) + { + int result = 1; + enum opt_code code = (enum opt_code) scode; + + switch (code) + { + default: + result = 0; + break; + + case OPT_cpp: + gfc_cpp_option.temporary_filename = arg; + break; + + case OPT_nocpp: + gfc_cpp_option.temporary_filename = 0L; + break; + + case OPT_d: + for ( ; *arg; ++arg) + switch (*arg) + { + case 'D': + case 'M': + case 'N': + case 'U': + gfc_cpp_option.dump_macros = *arg; + break; + + case 'I': + gfc_cpp_option.dump_includes = 1; + break; + } + break; + + case OPT_fworking_directory: + gfc_cpp_option.working_directory = value; + break; + + case OPT_idirafter: + gfc_cpp_add_include_path_after (xstrdup(arg), true); + break; + + case OPT_imultilib: + gfc_cpp_option.multilib = arg; + break; + + case OPT_iprefix: + gfc_cpp_option.prefix = arg; + break; + + case OPT_isysroot: + gfc_cpp_option.sysroot = arg; + break; + + case OPT_iquote: + case OPT_isystem: + gfc_cpp_add_include_path (xstrdup(arg), true); + break; + + case OPT_nostdinc: + gfc_cpp_option.standard_include_paths = value; + break; + + case OPT_o: + if (!gfc_cpp_option.output_filename) + gfc_cpp_option.output_filename = arg; + else + gfc_fatal_error ("output filename specified twice"); + break; + + case OPT_undef: + gfc_cpp_option.no_predefined = value; + break; + + case OPT_v: + gfc_cpp_option.verbose = value; + break; + + case OPT_A: + case OPT_D: + case OPT_U: + gfc_cpp_option.deferred_opt[gfc_cpp_option.deferred_opt_count].code = code; + gfc_cpp_option.deferred_opt[gfc_cpp_option.deferred_opt_count].arg = arg; + gfc_cpp_option.deferred_opt_count++; + break; + + case OPT_C: + gfc_cpp_option.discard_comments = 0; + break; + + case OPT_CC: + gfc_cpp_option.discard_comments = 0; + gfc_cpp_option.discard_comments_in_macro_exp = 0; + break; + + case OPT_E: + gfc_cpp_option.preprocess_only = 1; + break; + + case OPT_H: + gfc_cpp_option.print_include_names = 1; + break; + + case OPT_P: + gfc_cpp_option.no_line_commands = 1; + break; + } + + return result; + } + + + void + gfc_cpp_post_options (void) + { + /* Any preprocessing-related option without '-cpp' is considered + an error. */ + if (!gfc_cpp_enabled () + && (gfc_cpp_preprocess_only () + || !gfc_cpp_option.discard_comments + || !gfc_cpp_option.discard_comments_in_macro_exp + || gfc_cpp_option.print_include_names + || gfc_cpp_option.no_line_commands + || gfc_cpp_option.dump_macros + || gfc_cpp_option.dump_includes)) + gfc_fatal_error("To enable preprocessing, use -cpp"); + + cpp_in = cpp_create_reader (CLK_GNUC89, NULL, line_table); + if (!gfc_cpp_enabled()) + return; + + gcc_assert (cpp_in); + + /* The cpp_options-structure defines far more flags than those set here. + If any other is implemented, see c-opt.c (sanitize_cpp_opts) for + inter-option dependencies that may need to be enforced. */ + cpp_option = cpp_get_options (cpp_in); + gcc_assert (cpp_option); + + /* TODO: allow non-traditional modes, e.g. by -cpp-std=...? */ + cpp_option->traditional = 1; + cpp_option->cplusplus_comments = 0; + + cpp_option->pedantic = pedantic; + cpp_option->inhibit_warnings = inhibit_warnings; + + cpp_option->dollars_in_ident = gfc_option.flag_dollar_ok; + cpp_option->discard_comments = gfc_cpp_option.discard_comments; + cpp_option->discard_comments_in_macro_exp = gfc_cpp_option.discard_comments_in_macro_exp; + cpp_option->print_include_names = gfc_cpp_option.print_include_names; + cpp_option->preprocessed = gfc_option.flag_preprocessed; + + if (gfc_cpp_option.working_directory == -1) + gfc_cpp_option.working_directory = (debug_info_level != DINFO_LEVEL_NONE); + + cpp_post_options (cpp_in); + + /* If an error has occurred in cpplib, note it so we fail immediately. */ + errorcount += cpp_errors (cpp_in); + + gfc_cpp_register_include_paths (); + } + + + void + gfc_cpp_init_0 (void) + { + struct cpp_callbacks *cb; + + cb = cpp_get_callbacks (cpp_in); + cb->file_change = cb_file_change; + cb->line_change = cb_line_change; + cb->ident = cb_ident; + cb->def_pragma = cb_def_pragma; + + if (gfc_cpp_option.dump_includes) + cb->include = cb_include; + + if ((gfc_cpp_option.dump_macros == 'D') + || (gfc_cpp_option.dump_macros == 'N')) + { + cb->define = cb_define; + cb->undef = cb_undef; + } + + if (gfc_cpp_option.dump_macros == 'U') + { + cb->before_define = dump_queued_macros; + cb->used_define = cb_used_define; + cb->used_undef = cb_used_undef; + } + + /* Initialize the print structure. Setting print.src_line to -1 here is + a trick to guarantee that the first token of the file will cause + a linemarker to be output by maybe_print_line. */ + print.src_line = -1; + print.printed = 0; + print.prev = 0; + print.first_time = 1; + + if (gfc_cpp_preprocess_only ()) + { + if (gfc_cpp_option.output_filename) + { + /* This needs cheating: with "-E -o ", the user wants the + preprocessed output in . However, if nothing is done + about it is also used for assembler output. Hence, it + is necessary to redirect assembler output (actually nothing + as -E implies -fsyntax-only) to another file, otherwise the + output from preprocessing is lost. */ + asm_file_name = gfc_cpp_option.temporary_filename; + + print.outf = fopen (gfc_cpp_option.output_filename, "w"); + if (print.outf == NULL) + gfc_fatal_error ("opening output file %s: %s", + gfc_cpp_option.output_filename, strerror(errno)); + } + else + print.outf = stdout; + } + else + { + print.outf = fopen (gfc_cpp_option.temporary_filename, "w"); + if (print.outf == NULL) + gfc_fatal_error ("opening output file %s: %s", + gfc_cpp_option.temporary_filename, strerror(errno)); + } + + gcc_assert(cpp_in); + if (!cpp_read_main_file (cpp_in, gfc_source_file)) + errorcount++; + } + + void + gfc_cpp_init (void) + { + int i; + + if (gfc_option.flag_preprocessed) + return; + + cpp_change_file (cpp_in, LC_RENAME, _("")); + if (!gfc_cpp_option.no_predefined) + cpp_define_builtins (cpp_in); + + /* Handle deferred options from command-line. */ + cpp_change_file (cpp_in, LC_RENAME, _("")); + + for (i = 0; i < gfc_cpp_option.deferred_opt_count; i++) + { + gfc_cpp_deferred_opt_t *opt = &gfc_cpp_option.deferred_opt[i]; + + if (opt->code == OPT_D) + cpp_define (cpp_in, opt->arg); + else if (opt->code == OPT_U) + cpp_undef (cpp_in, opt->arg); + else if (opt->code == OPT_A) + { + if (opt->arg[0] == '-') + cpp_unassert (cpp_in, opt->arg + 1); + else + cpp_assert (cpp_in, opt->arg); + } + } + + if (gfc_cpp_option.working_directory + && gfc_cpp_option.preprocess_only && !gfc_cpp_option.no_line_commands) + pp_dir_change (cpp_in, get_src_pwd ()); + } + + gfc_try + gfc_cpp_preprocess (const char *source_file) + { + if (!gfc_cpp_enabled ()) + return FAILURE; + + cpp_change_file (cpp_in, LC_RENAME, source_file); + + if (cpp_option->traditional) + scan_translation_unit_trad (cpp_in); + else + scan_translation_unit (cpp_in); + + /* -dM command line option. */ + if (gfc_cpp_preprocess_only () && + gfc_cpp_option.dump_macros == 'M') + { + putc ('\n', print.outf); + cpp_forall_identifiers (cpp_in, dump_macro, NULL); + } + + putc ('\n', print.outf); + + if (!gfc_cpp_preprocess_only () + || (gfc_cpp_preprocess_only () && gfc_cpp_option.output_filename)) + fclose (print.outf); + + return SUCCESS; + } + + void + gfc_cpp_done (void) + { + if (!gfc_cpp_enabled ()) + return; + + /* TODO: if dependency tracking was enabled, call + cpp_finish() here to write dependencies. + + Use cpp_get_deps() to access the current source's + dependencies during parsing. Add dependencies using + the mkdeps-interface (defined in libcpp). */ + + gcc_assert (cpp_in); + cpp_undef_all (cpp_in); + cpp_clear_file_cache (cpp_in); + } + + /* PATH must be malloc-ed and NULL-terminated. */ + void + gfc_cpp_add_include_path (char *path, bool user_supplied) + { + /* CHAIN sets cpp_dir->sysp which differs from 0 if PATH is a system + include path. Fortran does not define any system include paths. */ + int cxx_aware = 0; + + add_path (path, BRACKET, cxx_aware, user_supplied); + } + + void + gfc_cpp_add_include_path_after (char *path, bool user_supplied) + { + int cxx_aware = 0; + add_path (path, AFTER, cxx_aware, user_supplied); + } + + void + gfc_cpp_register_include_paths (void) + { + int cxx_stdinc = 0; + register_include_chains (cpp_in, gfc_cpp_option.sysroot, + gfc_cpp_option.prefix, gfc_cpp_option.multilib, + gfc_cpp_option.standard_include_paths, cxx_stdinc, + gfc_cpp_option.verbose); + } + + + + static void scan_translation_unit_trad (cpp_reader *); + static void account_for_newlines (const unsigned char *, size_t); + static int dump_macro (cpp_reader *, cpp_hashnode *, void *); + + static void print_line (source_location, const char *); + static void maybe_print_line (source_location); + + + /* Writes out the preprocessed file, handling spacing and paste + avoidance issues. */ + static void + scan_translation_unit (cpp_reader *pfile) + { + bool avoid_paste = false; + + print.source = NULL; + for (;;) + { + const cpp_token *token = cpp_get_token (pfile); + + if (token->type == CPP_PADDING) + { + avoid_paste = true; + if (print.source == NULL + || (!(print.source->flags & PREV_WHITE) + && token->val.source == NULL)) + print.source = token->val.source; + continue; + } + + if (token->type == CPP_EOF) + break; + + /* Subtle logic to output a space if and only if necessary. */ + if (avoid_paste) + { + if (print.source == NULL) + print.source = token; + if (print.source->flags & PREV_WHITE + || (print.prev + && cpp_avoid_paste (pfile, print.prev, token)) + || (print.prev == NULL && token->type == CPP_HASH)) + putc (' ', print.outf); + } + else if (token->flags & PREV_WHITE) + putc (' ', print.outf); + + avoid_paste = false; + print.source = NULL; + print.prev = token; + cpp_output_token (token, print.outf); + + if (token->type == CPP_COMMENT) + account_for_newlines (token->val.str.text, token->val.str.len); + } + } + + /* Adjust print.src_line for newlines embedded in output. */ + static void + account_for_newlines (const unsigned char *str, size_t len) + { + while (len--) + if (*str++ == '\n') + print.src_line++; + } + + /* Writes out a traditionally preprocessed file. */ + static void + scan_translation_unit_trad (cpp_reader *pfile) + { + while (_cpp_read_logical_line_trad (pfile)) + { + size_t len = pfile->out.cur - pfile->out.base; + maybe_print_line (pfile->out.first_line); + fwrite (pfile->out.base, 1, len, print.outf); + print.printed = 1; + if (!CPP_OPTION (pfile, discard_comments)) + account_for_newlines (pfile->out.base, len); + } + } + + /* If the token read on logical line LINE needs to be output on a + different line to the current one, output the required newlines or + a line marker. */ + static void + maybe_print_line (source_location src_loc) + { + const struct line_map *map = linemap_lookup (line_table, src_loc); + int src_line = SOURCE_LINE (map, src_loc); + + /* End the previous line of text. */ + if (print.printed) + { + putc ('\n', print.outf); + print.src_line++; + print.printed = 0; + } + + if (src_line >= print.src_line && src_line < print.src_line + 8) + { + while (src_line > print.src_line) + { + putc ('\n', print.outf); + print.src_line++; + } + } + else + print_line (src_loc, ""); + } + + /* Output a line marker for logical line LINE. Special flags are "1" + or "2" indicating entering or leaving a file. */ + static void + print_line (source_location src_loc, const char *special_flags) + { + /* End any previous line of text. */ + if (print.printed) + putc ('\n', print.outf); + print.printed = 0; + + if (!gfc_cpp_option.no_line_commands) + { + const struct line_map *map = linemap_lookup (line_table, src_loc); + + size_t to_file_len = strlen (map->to_file); + unsigned char *to_file_quoted = + (unsigned char *) alloca (to_file_len * 4 + 1); + unsigned char *p; + + print.src_line = SOURCE_LINE (map, src_loc); + + /* cpp_quote_string does not nul-terminate, so we have to do it + ourselves. */ + p = cpp_quote_string (to_file_quoted, + (const unsigned char *) map->to_file, to_file_len); + *p = '\0'; + fprintf (print.outf, "# %u \"%s\"%s", + print.src_line == 0 ? 1 : print.src_line, + to_file_quoted, special_flags); + + if (map->sysp == 2) + fputs (" 3 4", print.outf); + else if (map->sysp == 1) + fputs (" 3", print.outf); + + putc ('\n', print.outf); + } + } + + static void + cb_file_change (cpp_reader * ARG_UNUSED (pfile), const struct line_map *map) + { + const char *flags = ""; + + if (gfc_cpp_option.no_line_commands) + return; + + if (!map) + return; + + if (print.first_time) + { + /* Avoid printing foo.i when the main file is foo.c. */ + if (!cpp_get_options (cpp_in)->preprocessed) + print_line (map->start_location, flags); + print.first_time = 0; + } + else + { + /* Bring current file to correct line when entering a new file. */ + if (map->reason == LC_ENTER) + { + const struct line_map *from = INCLUDED_FROM (line_table, map); + maybe_print_line (LAST_SOURCE_LINE_LOCATION (from)); + } + if (map->reason == LC_ENTER) + flags = " 1"; + else if (map->reason == LC_LEAVE) + flags = " 2"; + print_line (map->start_location, flags); + } + + } + + /* Called when a line of output is started. TOKEN is the first token + of the line, and at end of file will be CPP_EOF. */ + static void + cb_line_change (cpp_reader *pfile, const cpp_token *token, + int parsing_args) + { + source_location src_loc = token->src_loc; + + if (token->type == CPP_EOF || parsing_args) + return; + + maybe_print_line (src_loc); + print.prev = 0; + print.source = 0; + + /* Supply enough spaces to put this token in its original column, + one space per column greater than 2, since scan_translation_unit + will provide a space if PREV_WHITE. Don't bother trying to + reconstruct tabs; we can't get it right in general, and nothing + ought to care. Some things do care; the fault lies with them. */ + if (!CPP_OPTION (pfile, traditional)) + { + const struct line_map *map = linemap_lookup (line_table, src_loc); + int spaces = SOURCE_COLUMN (map, src_loc) - 2; + print.printed = 1; + + while (-- spaces >= 0) + putc (' ', print.outf); + } + } + + static void + cb_ident (cpp_reader *pfile ATTRIBUTE_UNUSED, source_location line, + const cpp_string *str) + { + maybe_print_line (line); + fprintf (print.outf, "#ident %s\n", str->text); + print.src_line++; + } + + static void + cb_define (cpp_reader *pfile ATTRIBUTE_UNUSED, source_location line, + cpp_hashnode *node ATTRIBUTE_UNUSED) + { + maybe_print_line (line); + fputs ("#define ", print.outf); + + /* 'D' is whole definition; 'N' is name only. */ + if (gfc_cpp_option.dump_macros == 'D') + fputs ((const char *) cpp_macro_definition (pfile, node), + print.outf); + else + fputs ((const char *) NODE_NAME (node), print.outf); + + putc ('\n', print.outf); + if (linemap_lookup (line_table, line)->to_line != 0) + print.src_line++; + } + + static void + cb_undef (cpp_reader *pfile ATTRIBUTE_UNUSED, source_location line, + cpp_hashnode *node) + { + maybe_print_line (line); + fprintf (print.outf, "#undef %s\n", NODE_NAME (node)); + print.src_line++; + } + + static void + cb_include (cpp_reader *pfile ATTRIBUTE_UNUSED, source_location line, + const unsigned char *dir, const char *header, int angle_brackets, + const cpp_token **comments) + { + maybe_print_line (line); + if (angle_brackets) + fprintf (print.outf, "#%s <%s>", dir, header); + else + fprintf (print.outf, "#%s \"%s\"", dir, header); + + if (comments != NULL) + { + while (*comments != NULL) + { + if ((*comments)->flags & PREV_WHITE) + putc (' ', print.outf); + cpp_output_token (*comments, print.outf); + ++comments; + } + } + + putc ('\n', print.outf); + print.src_line++; + } + + /* Dump out the hash table. */ + static int + dump_macro (cpp_reader *pfile, cpp_hashnode *node, void *v ATTRIBUTE_UNUSED) + { + if (node->type == NT_MACRO && !(node->flags & NODE_BUILTIN)) + { + fputs ("#define ", print.outf); + fputs ((const char *) cpp_macro_definition (pfile, node), + print.outf); + putc ('\n', print.outf); + print.src_line++; + } + + return 1; + } + + static void + cb_used_define (cpp_reader *pfile, source_location line ATTRIBUTE_UNUSED, + cpp_hashnode *node) + { + gfc_cpp_macro_queue *q; + q = XNEW (gfc_cpp_macro_queue); + q->macro = xstrdup ((const char *) cpp_macro_definition (pfile, node)); + q->next = cpp_define_queue; + cpp_define_queue = q; + } + + + /* Callback called when -fworking-director and -E to emit working + directory in cpp output file. */ + + void + pp_dir_change (cpp_reader *pfile ATTRIBUTE_UNUSED, const char *dir) + { + size_t to_file_len = strlen (dir); + unsigned char *to_file_quoted = + (unsigned char *) alloca (to_file_len * 4 + 1); + unsigned char *p; + + /* cpp_quote_string does not nul-terminate, so we have to do it ourselves. */ + p = cpp_quote_string (to_file_quoted, (const unsigned char *) dir, to_file_len); + *p = '\0'; + fprintf (print.outf, "# 1 \"%s//\"\n", to_file_quoted); + } + + /* Copy a #pragma directive to the preprocessed output. */ + static void + cb_def_pragma (cpp_reader *pfile, source_location line) + { + maybe_print_line (line); + fputs ("#pragma ", print.outf); + cpp_output_line (pfile, print.outf); + print.src_line++; + } + + static void + cb_used_undef (cpp_reader *pfile ATTRIBUTE_UNUSED, + source_location line ATTRIBUTE_UNUSED, + cpp_hashnode *node) + { + gfc_cpp_macro_queue *q; + q = XNEW (gfc_cpp_macro_queue); + q->macro = xstrdup ((const char *) NODE_NAME (node)); + q->next = cpp_undefine_queue; + cpp_undefine_queue = q; + } + + static void + dump_queued_macros (cpp_reader *pfile ATTRIBUTE_UNUSED) + { + gfc_cpp_macro_queue *q; + + /* End the previous line of text. */ + if (print.printed) + { + putc ('\n', print.outf); + print.src_line++; + print.printed = 0; + } + + for (q = cpp_define_queue; q;) + { + gfc_cpp_macro_queue *oq; + fputs ("#define ", print.outf); + fputs (q->macro, print.outf); + putc ('\n', print.outf); + print.src_line++; + oq = q; + q = q->next; + gfc_free (oq->macro); + gfc_free (oq); + } + cpp_define_queue = NULL; + for (q = cpp_undefine_queue; q;) + { + gfc_cpp_macro_queue *oq; + fprintf (print.outf, "#undef %s\n", q->macro); + print.src_line++; + oq = q; + q = q->next; + gfc_free (oq->macro); + gfc_free (oq); + } + cpp_undefine_queue = NULL; + } + + diff -Nrcpad gcc-4.3.3/gcc/fortran/cpp.h gcc-4.4.0/gcc/fortran/cpp.h *** gcc-4.3.3/gcc/fortran/cpp.h Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/gcc/fortran/cpp.h Tue Dec 9 19:25:55 2008 *************** *** 0 **** --- 1,48 ---- + /* Copyright (C) 2008 Free Software Foundation, Inc. + + This file is part of GCC. + + GCC is free software; you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free + Software Foundation; either version 3, or (at your option) any later + version. + + GCC is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + + #ifndef GFC_CPP_H + #define GFC_CPP_H + + /* Returns true if preprocessing is enabled, false otherwise. */ + bool gfc_cpp_enabled (void); + + bool gfc_cpp_preprocess_only (void); + + const char *gfc_cpp_temporary_file (void); + + + void gfc_cpp_init_0 (void); + void gfc_cpp_init (void); + + void gfc_cpp_init_options (unsigned int argc, const char **argv); + + int gfc_cpp_handle_option(size_t scode, const char *arg, int value); + + void gfc_cpp_post_options (void); + + gfc_try gfc_cpp_preprocess (const char *source_file); + + void gfc_cpp_done (void); + + void gfc_cpp_add_include_path (char *path, bool user_supplied); + void gfc_cpp_add_include_path_after (char *path, bool user_supplied); + + void gfc_cpp_register_include_paths (void); + + #endif /* GFC_CPP_H */ diff -Nrcpad gcc-4.3.3/gcc/fortran/data.c gcc-4.4.0/gcc/fortran/data.c *** gcc-4.3.3/gcc/fortran/data.c Tue Feb 5 20:40:45 2008 --- gcc-4.4.0/gcc/fortran/data.c Tue Jul 29 00:45:52 2008 *************** *** 1,5 **** /* Supporting functions for resolving DATA statement. ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Lifang Zeng --- 1,5 ---- /* Supporting functions for resolving DATA statement. ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Lifang Zeng *************** along with GCC; see the file COPYING3. *** 23,29 **** /* Notes for DATA statement implementation: We first assign initial value to each symbol by gfc_assign_data_value ! during resolveing DATA statement. Refer to check_data_variable and traverse_data_list in resolve.c. The complexity exists in the handling of array section, implied do --- 23,29 ---- /* Notes for DATA statement implementation: We first assign initial value to each symbol by gfc_assign_data_value ! during resolving DATA statement. Refer to check_data_variable and traverse_data_list in resolve.c. The complexity exists in the handling of array section, implied do *************** get_array_index (gfc_array_ref *ar, mpz_ *** 46,52 **** { gfc_expr *e; int i; ! try re; mpz_t delta; mpz_t tmp; --- 46,52 ---- { gfc_expr *e; int i; ! gfc_try re; mpz_t delta; mpz_t tmp; *************** find_con_by_component (gfc_component *co *** 144,160 **** /* Create a character type initialization expression from RVALUE. TS [and REF] describe [the substring of] the variable being initialized. ! INIT is thh existing initializer, not NULL. Initialization is performed according to normal assignment rules. */ static gfc_expr * create_character_intializer (gfc_expr *init, gfc_typespec *ts, gfc_ref *ref, gfc_expr *rvalue) { ! int len; ! int start; ! int end; ! char *dest, *rvalue_string; gfc_extract_int (ts->cl->length, &len); --- 144,158 ---- /* Create a character type initialization expression from RVALUE. TS [and REF] describe [the substring of] the variable being initialized. ! INIT is the existing initializer, not NULL. Initialization is performed according to normal assignment rules. */ static gfc_expr * create_character_intializer (gfc_expr *init, gfc_typespec *ts, gfc_ref *ref, gfc_expr *rvalue) { ! int len, start, end; ! gfc_char_t *dest; gfc_extract_int (ts->cl->length, &len); *************** create_character_intializer (gfc_expr *i *** 165,177 **** init->expr_type = EXPR_CONSTANT; init->ts = *ts; ! dest = gfc_getmem (len + 1); dest[len] = '\0'; init->value.character.length = len; init->value.character.string = dest; /* Blank the string if we're only setting a substring. */ if (ref != NULL) ! memset (dest, ' ', len); } else dest = init->value.character.string; --- 163,175 ---- init->expr_type = EXPR_CONSTANT; init->ts = *ts; ! dest = gfc_get_wide_string (len + 1); dest[len] = '\0'; init->value.character.length = len; init->value.character.string = dest; /* Blank the string if we're only setting a substring. */ if (ref != NULL) ! gfc_wide_memset (dest, ' ', len); } else dest = init->value.character.string; *************** create_character_intializer (gfc_expr *i *** 208,222 **** /* Copy the initial value. */ if (rvalue->ts.type == BT_HOLLERITH) ! { ! len = rvalue->representation.length; ! rvalue_string = rvalue->representation.string; ! } else ! { ! len = rvalue->value.character.length; ! rvalue_string = rvalue->value.character.string; ! } if (len > end - start) { --- 206,214 ---- /* Copy the initial value. */ if (rvalue->ts.type == BT_HOLLERITH) ! len = rvalue->representation.length; else ! len = rvalue->value.character.length; if (len > end - start) { *************** create_character_intializer (gfc_expr *i *** 225,240 **** "at %L", &rvalue->where); } ! memcpy (&dest[start], rvalue_string, len); /* Pad with spaces. Substrings will already be blanked. */ if (len < end - start && ref == NULL) ! memset (&dest[start + len], ' ', end - (start + len)); if (rvalue->ts.type == BT_HOLLERITH) { init->representation.length = init->value.character.length; ! init->representation.string = init->value.character.string; } return init; --- 217,242 ---- "at %L", &rvalue->where); } ! if (rvalue->ts.type == BT_HOLLERITH) ! { ! int i; ! for (i = 0; i < len; i++) ! dest[start+i] = rvalue->representation.string[i]; ! } ! else ! memcpy (&dest[start], rvalue->value.character.string, ! len * sizeof (gfc_char_t)); /* Pad with spaces. Substrings will already be blanked. */ if (len < end - start && ref == NULL) ! gfc_wide_memset (&dest[start + len], ' ', end - (start + len)); if (rvalue->ts.type == BT_HOLLERITH) { init->representation.length = init->value.character.length; ! init->representation.string ! = gfc_widechar_to_char (init->value.character.string, ! init->value.character.length); } return init; *************** create_character_intializer (gfc_expr *i *** 245,251 **** LVALUE already has an initialization, we extend this, otherwise we create a new one. */ ! try gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index) { gfc_ref *ref; --- 247,253 ---- LVALUE already has an initialization, we extend this, otherwise we create a new one. */ ! gfc_try gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index) { gfc_ref *ref; *************** gfc_assign_data_value (gfc_expr *lvalue, *** 424,437 **** /* Order in which the expressions arrive here depends on whether they are from data statements or F95 style declarations. Therefore, check which is the most recent. */ - #ifdef USE_MAPPED_LOCATION expr = (LOCATION_LINE (init->where.lb->location) > LOCATION_LINE (rvalue->where.lb->location)) ? init : rvalue; - #else - expr = (init->where.lb->linenum > rvalue->where.lb->linenum) - ? init : rvalue; - #endif gfc_notify_std (GFC_STD_GNU, "Extension: re-initialization " "of '%s' at %L", symbol->name, &expr->where); } --- 426,434 ---- *************** formalize_structure_cons (gfc_expr *expr *** 757,763 **** } ! /* Make sure an initialization expression is in normalized form. Ie. all elements of the constructors are in the correct order. */ static void --- 754,760 ---- } ! /* Make sure an initialization expression is in normalized form, i.e., all elements of the constructors are in the correct order. */ static void diff -Nrcpad gcc-4.3.3/gcc/fortran/data.h gcc-4.4.0/gcc/fortran/data.h *** gcc-4.3.3/gcc/fortran/data.h Fri Oct 5 12:33:07 2007 --- gcc-4.4.0/gcc/fortran/data.h Tue Jul 29 00:45:52 2008 *************** *** 1,5 **** /* Header for functions resolving DATA statements. ! Copyright (C) 2007 Free Software Foundation, Inc. This file is part of GCC. --- 1,5 ---- /* Header for functions resolving DATA statements. ! Copyright (C) 2007, 2008 Free Software Foundation, Inc. This file is part of GCC. *************** along with GCC; see the file COPYING3. *** 19,24 **** void gfc_formalize_init_value (gfc_symbol *); void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *); ! try gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t); void gfc_assign_data_value_range (gfc_expr *, gfc_expr *, mpz_t, mpz_t); void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *); --- 19,24 ---- void gfc_formalize_init_value (gfc_symbol *); void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *); ! gfc_try gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t); void gfc_assign_data_value_range (gfc_expr *, gfc_expr *, mpz_t, mpz_t); void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *); diff -Nrcpad gcc-4.3.3/gcc/fortran/decl.c gcc-4.4.0/gcc/fortran/decl.c *** gcc-4.3.3/gcc/fortran/decl.c Wed Sep 24 08:04:26 2008 --- gcc-4.4.0/gcc/fortran/decl.c Tue Dec 2 11:58:16 2008 *************** *** 1,5 **** /* Declaration statement matcher ! Copyright (C) 2002, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Declaration statement matcher ! Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Andy Vaught *************** along with GCC; see the file COPYING3. *** 28,36 **** /* Macros to access allocate memory for gfc_data_variable, gfc_data_value and gfc_data. */ ! #define gfc_get_data_variable() gfc_getmem (sizeof (gfc_data_variable)) ! #define gfc_get_data_value() gfc_getmem (sizeof (gfc_data_value)) ! #define gfc_get_data() gfc_getmem( sizeof (gfc_data)) /* This flag is set if an old-style length selector is matched --- 28,36 ---- /* Macros to access allocate memory for gfc_data_variable, gfc_data_value and gfc_data. */ ! #define gfc_get_data_variable() XCNEW (gfc_data_variable) ! #define gfc_get_data_value() XCNEW (gfc_data_value) ! #define gfc_get_data() XCNEW (gfc_data) /* This flag is set if an old-style length selector is matched *************** syntax: *** 231,251 **** variable-iterator list. */ static match ! var_element (gfc_data_variable *new) { match m; gfc_symbol *sym; ! memset (new, 0, sizeof (gfc_data_variable)); if (gfc_match_char ('(') == MATCH_YES) ! return var_list (new); ! m = gfc_match_variable (&new->expr, 0); if (m != MATCH_YES) return m; ! sym = new->expr->symtree->n.sym; if (!sym->attr.function && gfc_current_ns->parent && gfc_current_ns->parent == sym->ns) --- 231,256 ---- variable-iterator list. */ static match ! var_element (gfc_data_variable *new_var) { match m; gfc_symbol *sym; ! memset (new_var, 0, sizeof (gfc_data_variable)); if (gfc_match_char ('(') == MATCH_YES) ! return var_list (new_var); ! m = gfc_match_variable (&new_var->expr, 0); if (m != MATCH_YES) return m; ! sym = new_var->expr->symtree->n.sym; ! ! /* Symbol should already have an associated type. */ ! if (gfc_check_symbol_typed (sym, gfc_current_ns, ! false, gfc_current_locus) == FAILURE) ! return MATCH_ERROR; if (!sym->attr.function && gfc_current_ns->parent && gfc_current_ns->parent == sym->ns) *************** var_element (gfc_data_variable *new) *** 262,268 **** sym->name) == FAILURE) return MATCH_ERROR; ! if (gfc_add_data (&sym->attr, sym->name, &new->expr->where) == FAILURE) return MATCH_ERROR; return MATCH_YES; --- 267,273 ---- sym->name) == FAILURE) return MATCH_ERROR; ! if (gfc_add_data (&sym->attr, sym->name, &new_var->expr->where) == FAILURE) return MATCH_ERROR; return MATCH_YES; *************** var_element (gfc_data_variable *new) *** 274,280 **** static match top_var_list (gfc_data *d) { ! gfc_data_variable var, *tail, *new; match m; tail = NULL; --- 279,285 ---- static match top_var_list (gfc_data *d) { ! gfc_data_variable var, *tail, *new_var; match m; tail = NULL; *************** top_var_list (gfc_data *d) *** 287,301 **** if (m == MATCH_ERROR) return MATCH_ERROR; ! new = gfc_get_data_variable (); ! *new = var; if (tail == NULL) ! d->var = new; else ! tail->next = new; ! tail = new; if (gfc_match_char ('/') == MATCH_YES) break; --- 292,306 ---- if (m == MATCH_ERROR) return MATCH_ERROR; ! new_var = gfc_get_data_variable (); ! *new_var = var; if (tail == NULL) ! d->var = new_var; else ! tail->next = new_var; ! tail = new_var; if (gfc_match_char ('/') == MATCH_YES) break; *************** match_data_constant (gfc_expr **result) *** 367,373 **** return MATCH_ERROR; } else if (sym->attr.flavor == FL_DERIVED) ! return gfc_match_structure_constructor (sym, result); /* Check to see if the value is an initialization array expression. */ if (sym->value->expr_type == EXPR_ARRAY) --- 372,378 ---- return MATCH_ERROR; } else if (sym->attr.flavor == FL_DERIVED) ! return gfc_match_structure_constructor (sym, result, false); /* Check to see if the value is an initialization array expression. */ if (sym->value->expr_type == EXPR_ARRAY) *************** match_data_constant (gfc_expr **result) *** 404,410 **** static match top_val_list (gfc_data *data) { ! gfc_data_value *new, *tail; gfc_expr *expr; match m; --- 409,415 ---- static match top_val_list (gfc_data *data) { ! gfc_data_value *new_val, *tail; gfc_expr *expr; match m; *************** top_val_list (gfc_data *data) *** 418,432 **** if (m == MATCH_ERROR) return MATCH_ERROR; ! new = gfc_get_data_value (); ! mpz_init (new->repeat); if (tail == NULL) ! data->value = new; else ! tail->next = new; ! tail = new; if (expr->ts.type != BT_INTEGER || gfc_match_char ('*') != MATCH_YES) { --- 423,437 ---- if (m == MATCH_ERROR) return MATCH_ERROR; ! new_val = gfc_get_data_value (); ! mpz_init (new_val->repeat); if (tail == NULL) ! data->value = new_val; else ! tail->next = new_val; ! tail = new_val; if (expr->ts.type != BT_INTEGER || gfc_match_char ('*') != MATCH_YES) { *************** match_old_style_init (const char *name) *** 518,543 **** match gfc_match_data (void) { ! gfc_data *new; match m; set_in_match_data (true); for (;;) { ! new = gfc_get_data (); ! new->where = gfc_current_locus; ! m = top_var_list (new); if (m != MATCH_YES) goto cleanup; ! m = top_val_list (new); if (m != MATCH_YES) goto cleanup; ! new->next = gfc_current_ns->data; ! gfc_current_ns->data = new; if (gfc_match_eos () == MATCH_YES) break; --- 523,548 ---- match gfc_match_data (void) { ! gfc_data *new_data; match m; set_in_match_data (true); for (;;) { ! new_data = gfc_get_data (); ! new_data->where = gfc_current_locus; ! m = top_var_list (new_data); if (m != MATCH_YES) goto cleanup; ! m = top_val_list (new_data); if (m != MATCH_YES) goto cleanup; ! new_data->next = gfc_current_ns->data; ! gfc_current_ns->data = new_data; if (gfc_match_eos () == MATCH_YES) break; *************** gfc_match_data (void) *** 557,563 **** cleanup: set_in_match_data (false); ! gfc_free_data (new); return MATCH_ERROR; } --- 562,568 ---- cleanup: set_in_match_data (false); ! gfc_free_data (new_data); return MATCH_ERROR; } *************** char_len_param_value (gfc_expr **expr) *** 598,603 **** --- 603,613 ---- } m = gfc_match_expr (expr); + + if (m == MATCH_YES + && gfc_expr_check_typed (*expr, gfc_current_ns, false) == FAILURE) + return MATCH_ERROR; + if (m == MATCH_YES && (*expr)->expr_type == EXPR_FUNCTION) { if ((*expr)->value.function.actual *************** get_proc_name (const char *name, gfc_sym *** 762,768 **** (*result)->ts = sym->ts; /* Put the symbol in the procedure namespace so that, should ! the ENTRY preceed its specification, the specification can be applied. */ (*result)->ns = gfc_current_ns; --- 772,778 ---- (*result)->ts = sym->ts; /* Put the symbol in the procedure namespace so that, should ! the ENTRY precede its specification, the specification can be applied. */ (*result)->ns = gfc_current_ns; *************** get_proc_name (const char *name, gfc_sym *** 781,787 **** sym = *result; gfc_current_ns->refs++; ! if (sym && !sym->new && gfc_current_state () != COMP_INTERFACE) { /* Trap another encompassed procedure with the same name. All these conditions are necessary to avoid picking up an entry --- 791,797 ---- sym = *result; gfc_current_ns->refs++; ! if (sym && !sym->gfc_new && gfc_current_state () != COMP_INTERFACE) { /* Trap another encompassed procedure with the same name. All these conditions are necessary to avoid picking up an entry *************** get_proc_name (const char *name, gfc_sym *** 867,877 **** the compiler could have automatically handled the varying sizes across platforms. */ ! try verify_c_interop_param (gfc_symbol *sym) { int is_c_interop = 0; ! try retval = SUCCESS; /* We check implicitly typed variables in symbol.c:gfc_set_default_type(). Don't repeat the checks here. */ --- 877,887 ---- the compiler could have automatically handled the varying sizes across platforms. */ ! gfc_try verify_c_interop_param (gfc_symbol *sym) { int is_c_interop = 0; ! gfc_try retval = SUCCESS; /* We check implicitly typed variables in symbol.c:gfc_set_default_type(). Don't repeat the checks here. */ *************** verify_c_interop_param (gfc_symbol *sym) *** 908,914 **** if (sym->ns->proc_name->attr.is_bind_c == 1) { is_c_interop = ! (verify_c_interop (&(sym->ts), sym->name, &(sym->declared_at)) == SUCCESS ? 1 : 0); if (is_c_interop != 1) --- 918,924 ---- if (sym->ns->proc_name->attr.is_bind_c == 1) { is_c_interop = ! (verify_c_interop (&(sym->ts)) == SUCCESS ? 1 : 0); if (is_c_interop != 1) *************** verify_c_interop_param (gfc_symbol *sym) *** 1009,1015 **** /* Function called by variable_decl() that adds a name to the symbol table. */ ! static try build_sym (const char *name, gfc_charlen *cl, gfc_array_spec **as, locus *var_locus) { --- 1019,1025 ---- /* Function called by variable_decl() that adds a name to the symbol table. */ ! static gfc_try build_sym (const char *name, gfc_charlen *cl, gfc_array_spec **as, locus *var_locus) { *************** build_sym (const char *name, gfc_charlen *** 1084,1107 **** /* Set character constant to the given length. The constant will be padded or ! truncated. */ void ! gfc_set_constant_character_len (int len, gfc_expr *expr, bool array) { ! char *s; int slen; gcc_assert (expr->expr_type == EXPR_CONSTANT); ! gcc_assert (expr->ts.type == BT_CHARACTER && expr->ts.kind == 1); slen = expr->value.character.length; if (len != slen) { ! s = gfc_getmem (len + 1); ! memcpy (s, expr->value.character.string, MIN (len, slen)); if (len > slen) ! memset (&s[slen], ' ', len - slen); if (gfc_option.warn_character_truncation && slen > len) gfc_warning_now ("CHARACTER expression at %L is being truncated " --- 1094,1120 ---- /* Set character constant to the given length. The constant will be padded or ! truncated. If we're inside an array constructor without a typespec, we ! additionally check that all elements have the same length; check_len -1 ! means no checking. */ void ! 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); ! gcc_assert (expr->ts.type == BT_CHARACTER); slen = expr->value.character.length; if (len != slen) { ! s = gfc_get_wide_string (len + 1); ! memcpy (s, expr->value.character.string, ! MIN (len, slen) * sizeof (gfc_char_t)); if (len > slen) ! gfc_wide_memset (&s[slen], ' ', len - slen); if (gfc_option.warn_character_truncation && slen > len) gfc_warning_now ("CHARACTER expression at %L is being truncated " *************** gfc_set_constant_character_len (int len, *** 1109,1118 **** /* Apply the standard by 'hand' otherwise it gets cleared for initializers. */ ! if (array && slen < len && !(gfc_option.allow_std & GFC_STD_GNU)) gfc_error_now ("The CHARACTER elements of the array constructor " "at %L must have the same length (%d/%d)", ! &expr->where, slen, len); s[len] = '\0'; gfc_free (expr->value.character.string); --- 1122,1132 ---- /* Apply the standard by 'hand' otherwise it gets cleared for initializers. */ ! if (check_len != -1 && slen != check_len ! && !(gfc_option.allow_std & GFC_STD_GNU)) gfc_error_now ("The CHARACTER elements of the array constructor " "at %L must have the same length (%d/%d)", ! &expr->where, slen, check_len); s[len] = '\0'; gfc_free (expr->value.character.string); *************** create_enum_history (gfc_symbol *sym, gf *** 1136,1142 **** enumerator_history *new_enum_history; gcc_assert (sym != NULL && init != NULL); ! new_enum_history = gfc_getmem (sizeof (enumerator_history)); new_enum_history->sym = sym; new_enum_history->initializer = init; --- 1150,1156 ---- enumerator_history *new_enum_history; gcc_assert (sym != NULL && init != NULL); ! new_enum_history = XCNEW (enumerator_history); new_enum_history->sym = sym; new_enum_history->initializer = init; *************** gfc_free_enum_history (void) *** 1181,1187 **** /* Function called by variable_decl() that adds an initialization expression to a symbol. */ ! static try add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) { symbol_attribute attr; --- 1195,1201 ---- /* Function called by variable_decl() that adds an initialization expression to a symbol. */ ! static gfc_try add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) { symbol_attribute attr; *************** add_init_expr_to_sym (const char *name, *** 1268,1274 **** gfc_constructor * p; if (init->expr_type == EXPR_CONSTANT) ! gfc_set_constant_character_len (len, init, false); else if (init->expr_type == EXPR_ARRAY) { /* Build a new charlen to prevent simplification from --- 1282,1288 ---- gfc_constructor * p; if (init->expr_type == EXPR_CONSTANT) ! gfc_set_constant_character_len (len, init, -1); else if (init->expr_type == EXPR_ARRAY) { /* Build a new charlen to prevent simplification from *************** add_init_expr_to_sym (const char *name, *** 1279,1285 **** init->ts.cl->length = gfc_copy_expr (sym->ts.cl->length); for (p = init->value.constructor; p; p = p->next) ! gfc_set_constant_character_len (len, p->expr, false); } } } --- 1293,1299 ---- init->ts.cl->length = gfc_copy_expr (sym->ts.cl->length); for (p = init->value.constructor; p; p = p->next) ! gfc_set_constant_character_len (len, p->expr, -1); } } } *************** add_init_expr_to_sym (const char *name, *** 1358,1364 **** /* Function called by variable_decl() that adds a name to a structure being built. */ ! static try build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, gfc_array_spec **as) { --- 1372,1378 ---- /* Function called by variable_decl() that adds a name to a structure being built. */ ! static gfc_try build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, gfc_array_spec **as) { *************** build_struct (const char *name, gfc_char *** 1389,1426 **** c->ts = current_ts; c->ts.cl = cl; ! gfc_set_component_attr (c, ¤t_attr); c->initializer = *init; *init = NULL; c->as = *as; if (c->as != NULL) ! c->dimension = 1; *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->pointer && c->initializer) { ! int len = mpz_get_si (c->ts.cl->length->value.integer); if (c->initializer->expr_type == EXPR_CONSTANT) ! gfc_set_constant_character_len (len, c->initializer, false); else if (mpz_cmp (c->ts.cl->length->value.integer, c->initializer->ts.cl->length->value.integer)) { gfc_constructor *ctor = c->initializer->value.constructor; ! for (;ctor ; ctor = ctor->next) ! if (ctor->expr->expr_type == EXPR_CONSTANT) ! gfc_set_constant_character_len (len, ctor->expr, true); } } /* Check array components. */ ! if (!c->dimension) { ! if (c->allocatable) { gfc_error ("Allocatable component at %C must be an array"); return FAILURE; --- 1403,1469 ---- c->ts = current_ts; c->ts.cl = cl; ! c->attr = current_attr; c->initializer = *init; *init = NULL; c->as = *as; if (c->as != NULL) ! c->attr.dimension = 1; *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.cl ! && c->ts.cl->length && c->ts.cl->length->expr_type == EXPR_CONSTANT) { ! int len; ! ! gcc_assert (c->ts.cl && c->ts.cl->length); ! gcc_assert (c->ts.cl->length->expr_type == EXPR_CONSTANT); ! gcc_assert (c->ts.cl->length->ts.type == BT_INTEGER); ! ! len = mpz_get_si (c->ts.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.cl->length->value.integer, c->initializer->ts.cl->length->value.integer)) { + bool has_ts; gfc_constructor *ctor = c->initializer->value.constructor; ! ! bool first = true; ! int first_len; ! ! has_ts = (c->initializer->ts.cl ! && c->initializer->ts.cl->length_from_typespec); ! ! for (; ctor; ctor = ctor->next) ! { ! /* 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! */ ! if (first) ! { ! gcc_assert (ctor->expr->expr_type == EXPR_CONSTANT); ! gcc_assert (ctor->expr->ts.type == BT_CHARACTER); ! first_len = ctor->expr->value.character.length; ! first = false; ! } ! ! if (ctor->expr->expr_type == EXPR_CONSTANT) ! gfc_set_constant_character_len (len, ctor->expr, ! has_ts ? -1 : first_len); ! } } } /* Check array components. */ ! if (!c->attr.dimension) { ! if (c->attr.allocatable) { gfc_error ("Allocatable component at %C must be an array"); return FAILURE; *************** build_struct (const char *name, gfc_char *** 1429,1435 **** return SUCCESS; } ! if (c->pointer) { if (c->as->type != AS_DEFERRED) { --- 1472,1478 ---- return SUCCESS; } ! if (c->attr.pointer) { if (c->as->type != AS_DEFERRED) { *************** build_struct (const char *name, gfc_char *** 1438,1444 **** return FAILURE; } } ! else if (c->allocatable) { if (c->as->type != AS_DEFERRED) { --- 1481,1487 ---- return FAILURE; } } ! else if (c->attr.allocatable) { if (c->as->type != AS_DEFERRED) { *************** variable_decl (int elem) *** 1515,1521 **** gfc_charlen *cl; locus var_locus; match m; ! try t; gfc_symbol *sym; locus old_locus; --- 1558,1564 ---- gfc_charlen *cl; locus var_locus; match m; ! gfc_try t; gfc_symbol *sym; locus old_locus; *************** kind_expr: *** 1939,1946 **** return MATCH_ERROR; } gfc_gobble_whitespace (); ! if ((c = gfc_next_char ()) != ')' && (ts->type != BT_CHARACTER || c != ',')) { if (ts->type == BT_CHARACTER) gfc_error ("Missing right parenthesis or comma at %C"); --- 1982,2001 ---- return MATCH_ERROR; } + /* Warn if, e.g., c_int is used for a REAL variable, but not + if, e.g., c_double is used for COMPLEX as the standard + explicitly says that the kind type parameter for complex and real + variable is the same, i.e. c_float == c_float_complex. */ + if (ts->f90_type != BT_UNKNOWN && ts->f90_type != ts->type + && !((ts->f90_type == BT_REAL && ts->type == BT_COMPLEX) + || (ts->f90_type == BT_COMPLEX && ts->type == BT_REAL))) + gfc_error_now ("C kind type parameter is for type %s but type at %L " + "is %s", gfc_basic_typename (ts->f90_type), &where, + gfc_basic_typename (ts->type)); + gfc_gobble_whitespace (); ! if ((c = gfc_next_ascii_char ()) != ')' ! && (ts->type != BT_CHARACTER || c != ',')) { if (ts->type == BT_CHARACTER) gfc_error ("Missing right parenthesis or comma at %C"); *************** gfc_match_type_spec (gfc_typespec *ts, i *** 2213,2219 **** char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_symbol *sym; match m; ! int c; bool seen_deferred_kind; /* A belt and braces check that the typespec is correctly being treated --- 2268,2274 ---- char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_symbol *sym; match m; ! char c; bool seen_deferred_kind; /* A belt and braces check that the typespec is correctly being treated *************** get_kind: *** 2360,2366 **** if (gfc_current_form == FORM_FREE) { ! c = gfc_peek_char(); if (!gfc_is_whitespace(c) && c != '*' && c != '(' && c != ':' && c != ',') return MATCH_NO; --- 2415,2421 ---- if (gfc_current_form == FORM_FREE) { ! c = gfc_peek_ascii_char(); if (!gfc_is_whitespace(c) && c != '*' && c != '(' && c != ':' && c != ',') return MATCH_NO; *************** gfc_match_implicit_none (void) *** 2400,2412 **** static match match_implicit_range (void) { ! int c, c1, c2, inner; locus cur_loc; cur_loc = gfc_current_locus; gfc_gobble_whitespace (); ! c = gfc_next_char (); if (c != '(') { gfc_error ("Missing character range in IMPLICIT at %C"); --- 2455,2468 ---- static match match_implicit_range (void) { ! char c, c1, c2; ! int inner; locus cur_loc; cur_loc = gfc_current_locus; gfc_gobble_whitespace (); ! c = gfc_next_ascii_char (); if (c != '(') { gfc_error ("Missing character range in IMPLICIT at %C"); *************** match_implicit_range (void) *** 2417,2428 **** while (inner) { gfc_gobble_whitespace (); ! c1 = gfc_next_char (); if (!ISALPHA (c1)) goto bad; gfc_gobble_whitespace (); ! c = gfc_next_char (); switch (c) { --- 2473,2484 ---- while (inner) { gfc_gobble_whitespace (); ! c1 = gfc_next_ascii_char (); if (!ISALPHA (c1)) goto bad; gfc_gobble_whitespace (); ! c = gfc_next_ascii_char (); switch (c) { *************** match_implicit_range (void) *** 2435,2446 **** case '-': gfc_gobble_whitespace (); ! c2 = gfc_next_char (); if (!ISALPHA (c2)) goto bad; gfc_gobble_whitespace (); ! c = gfc_next_char (); if ((c != ',') && (c != ')')) goto bad; --- 2491,2502 ---- case '-': gfc_gobble_whitespace (); ! c2 = gfc_next_ascii_char (); if (!ISALPHA (c2)) goto bad; gfc_gobble_whitespace (); ! c = gfc_next_ascii_char (); if ((c != ',') && (c != ')')) goto bad; *************** gfc_match_implicit (void) *** 2503,2511 **** { gfc_typespec ts; locus cur_loc; ! int c; match m; /* We don't allow empty implicit statements. */ if (gfc_match_eos () == MATCH_YES) { --- 2559,2569 ---- { gfc_typespec ts; locus cur_loc; ! char c; match m; + gfc_clear_ts (&ts); + /* We don't allow empty implicit statements. */ if (gfc_match_eos () == MATCH_YES) { *************** gfc_match_implicit (void) *** 2532,2538 **** { /* We may have (). */ gfc_gobble_whitespace (); ! c = gfc_next_char (); if ((c == '\n') || (c == ',')) { /* Check for CHARACTER with no length parameter. */ --- 2590,2596 ---- { /* We may have (). */ gfc_gobble_whitespace (); ! c = gfc_next_ascii_char (); if ((c == '\n') || (c == ',')) { /* Check for CHARACTER with no length parameter. */ *************** gfc_match_implicit (void) *** 2582,2588 **** goto syntax; gfc_gobble_whitespace (); ! c = gfc_next_char (); if ((c != '\n') && (c != ',')) goto syntax; --- 2640,2646 ---- goto syntax; gfc_gobble_whitespace (); ! c = gfc_next_ascii_char (); if ((c != '\n') && (c != ',')) goto syntax; *************** match_string_p (const char *target) *** 2711,2717 **** const char *p; for (p = target; *p; p++) ! if (gfc_next_char () != *p) return false; return true; } --- 2769,2775 ---- const char *p; for (p = target; *p; p++) ! if ((char) gfc_next_ascii_char () != *p) return false; return true; } *************** match_attr_spec (void) *** 2749,2755 **** decl_types d; const char *attr; match m; ! try t; gfc_clear_attr (¤t_attr); start = gfc_current_locus; --- 2807,2813 ---- decl_types d; const char *attr; match m; ! gfc_try t; gfc_clear_attr (¤t_attr); start = gfc_current_locus; *************** match_attr_spec (void) *** 2763,2784 **** for (;;) { ! int ch; d = DECL_NONE; gfc_gobble_whitespace (); ! ch = gfc_next_char (); if (ch == ':') { /* This is the successful exit condition for the loop. */ ! if (gfc_next_char () == ':') break; } else if (ch == ',') { gfc_gobble_whitespace (); ! switch (gfc_peek_char ()) { case 'a': if (match_string_p ("allocatable")) --- 2821,2842 ---- for (;;) { ! char ch; d = DECL_NONE; gfc_gobble_whitespace (); ! ch = gfc_next_ascii_char (); if (ch == ':') { /* This is the successful exit condition for the loop. */ ! if (gfc_next_ascii_char () == ':') break; } else if (ch == ',') { gfc_gobble_whitespace (); ! switch (gfc_peek_ascii_char ()) { case 'a': if (match_string_p ("allocatable")) *************** match_attr_spec (void) *** 2807,2813 **** case 'i': if (match_string_p ("int")) { ! ch = gfc_next_char (); if (ch == 'e') { if (match_string_p ("nt")) --- 2865,2871 ---- case 'i': if (match_string_p ("int")) { ! ch = gfc_next_ascii_char (); if (ch == 'e') { if (match_string_p ("nt")) *************** match_attr_spec (void) *** 2839,2846 **** break; case 'p': ! gfc_next_char (); ! switch (gfc_next_char ()) { case 'a': if (match_string_p ("rameter")) --- 2897,2904 ---- break; case 'p': ! gfc_next_ascii_char (); ! switch (gfc_next_ascii_char ()) { case 'a': if (match_string_p ("rameter")) *************** match_attr_spec (void) *** 2859,2865 **** break; case 'r': ! ch = gfc_next_char (); if (ch == 'i') { if (match_string_p ("vate")) --- 2917,2923 ---- break; case 'r': ! ch = gfc_next_ascii_char (); if (ch == 'i') { if (match_string_p ("vate")) *************** match_attr_spec (void) *** 2899,2906 **** break; case 'v': ! gfc_next_char (); ! ch = gfc_next_char (); if (ch == 'a') { if (match_string_p ("lue")) --- 2957,2964 ---- break; case 'v': ! gfc_next_ascii_char (); ! ch = gfc_next_ascii_char (); if (ch == 'a') { if (match_string_p ("lue")) *************** match_attr_spec (void) *** 2929,2934 **** --- 2987,2999 ---- goto cleanup; } + /* Check to make sure any parens are paired up correctly. */ + if (gfc_match_parens () == MATCH_ERROR) + { + m = MATCH_ERROR; + goto cleanup; + } + seen[d]++; seen_at[d] = gfc_current_locus; *************** cleanup: *** 3204,3210 **** (J3/04-007, section 15.4.1). If a binding label was given and there is more than one argument (num_idents), it is an error. */ ! try set_binding_label (char *dest_label, const char *sym_name, int num_idents) { if (num_idents > 1 && has_name_equals) --- 3269,3275 ---- (J3/04-007, section 15.4.1). If a binding label was given and there is more than one argument (num_idents), it is an error. */ ! gfc_try set_binding_label (char *dest_label, const char *sym_name, int num_idents) { if (num_idents > 1 && has_name_equals) *************** set_com_block_bind_c (gfc_common_head *c *** 3244,3273 **** /* Verify that the given gfc_typespec is for a C interoperable type. */ ! try ! verify_c_interop (gfc_typespec *ts, const char *name, locus *where) { - try t; - - /* Make sure the kind used is appropriate for the type. - The f90_type is unknown if an integer constant was - used (e.g., real(4), bind(c) :: myFloat). */ - if (ts->f90_type != BT_UNKNOWN) - { - t = gfc_validate_c_kind (ts); - if (t != SUCCESS) - { - /* Print an error, but continue parsing line. */ - gfc_error_now ("C kind parameter is for type %s but " - "symbol '%s' at %L is of type %s", - gfc_basic_typename (ts->f90_type), - name, where, - gfc_basic_typename (ts->type)); - } - } - - /* Make sure the kind is C interoperable. This does not care about the - possible error above. */ if (ts->type == BT_DERIVED && ts->derived != NULL) return (ts->derived->ts.is_c_interop ? SUCCESS : FAILURE); else if (ts->is_c_interop != 1) --- 3309,3317 ---- /* Verify that the given gfc_typespec is for a C interoperable type. */ ! gfc_try ! verify_c_interop (gfc_typespec *ts) { if (ts->type == BT_DERIVED && ts->derived != NULL) return (ts->derived->ts.is_c_interop ? SUCCESS : FAILURE); else if (ts->is_c_interop != 1) *************** verify_c_interop (gfc_typespec *ts, cons *** 3282,3292 **** interoperable type. Errors will be reported here, if encountered. */ ! try verify_com_block_vars_c_interop (gfc_common_head *com_block) { gfc_symbol *curr_sym = NULL; ! try retval = SUCCESS; curr_sym = com_block->head; --- 3326,3336 ---- interoperable type. Errors will be reported here, if encountered. */ ! gfc_try verify_com_block_vars_c_interop (gfc_common_head *com_block) { gfc_symbol *curr_sym = NULL; ! gfc_try retval = SUCCESS; curr_sym = com_block->head; *************** verify_com_block_vars_c_interop (gfc_com *** 3310,3320 **** /* Verify that a given BIND(C) symbol is C interoperable. If it is not, an appropriate error message is reported. */ ! try verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts, int is_in_common, gfc_common_head *com_block) { ! try retval = SUCCESS; if (tmp_sym->attr.function && tmp_sym->result != NULL) { --- 3354,3368 ---- /* Verify that a given BIND(C) symbol is C interoperable. If it is not, an appropriate error message is reported. */ ! gfc_try verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts, int is_in_common, gfc_common_head *com_block) { ! bool bind_c_function = false; ! gfc_try retval = SUCCESS; ! ! if (tmp_sym->attr.function && tmp_sym->attr.is_bind_c) ! bind_c_function = true; if (tmp_sym->attr.function && tmp_sym->result != NULL) { *************** verify_bind_c_sym (gfc_symbol *tmp_sym, *** 3331,3345 **** tmp_sym->attr.is_c_interop = 1; } } ! /* Here, we know we have the bind(c) attribute, so if we have enough type info, then verify that it's a C interop kind. The info could be in the symbol already, or possibly still in the given ts (current_ts), so look in both. */ if (tmp_sym->ts.type != BT_UNKNOWN || ts->type != BT_UNKNOWN) { ! if (verify_c_interop (&(tmp_sym->ts), tmp_sym->name, ! &(tmp_sym->declared_at)) != SUCCESS) { /* See if we're dealing with a sym in a common block or not. */ if (is_in_common == 1) --- 3379,3392 ---- tmp_sym->attr.is_c_interop = 1; } } ! /* Here, we know we have the bind(c) attribute, so if we have enough type info, then verify that it's a C interop kind. The info could be in the symbol already, or possibly still in the given ts (current_ts), so look in both. */ if (tmp_sym->ts.type != BT_UNKNOWN || ts->type != BT_UNKNOWN) { ! if (verify_c_interop (&(tmp_sym->ts)) != SUCCESS) { /* See if we're dealing with a sym in a common block or not. */ if (is_in_common == 1) *************** verify_bind_c_sym (gfc_symbol *tmp_sym, *** 3397,3418 **** retval = FAILURE; } ! /* If it is a BIND(C) function, make sure the return value is a ! scalar value. The previous tests in this function made sure ! the type is interoperable. */ ! if (tmp_sym->attr.function == 1 && tmp_sym->as != NULL) ! gfc_error ("Return type of BIND(C) function '%s' at %L cannot " ! "be an array", tmp_sym->name, &(tmp_sym->declared_at)); ! /* BIND(C) functions can not return a character string. */ ! if (tmp_sym->attr.function == 1 && tmp_sym->ts.type == BT_CHARACTER) ! if (tmp_sym->ts.cl == NULL || tmp_sym->ts.cl->length == NULL ! || tmp_sym->ts.cl->length->expr_type != EXPR_CONSTANT ! || mpz_cmp_si (tmp_sym->ts.cl->length->value.integer, 1) != 0) ! gfc_error ("Return type of BIND(C) function '%s' at %L cannot " "be a character string", tmp_sym->name, &(tmp_sym->declared_at)); - } } /* See if the symbol has been marked as private. If it has, make sure --- 3444,3466 ---- retval = FAILURE; } ! } ! /* If it is a BIND(C) function, make sure the return value is a ! scalar value. The previous tests in this function made sure ! the type is interoperable. */ ! if (bind_c_function && tmp_sym->as != NULL) ! gfc_error ("Return type of BIND(C) function '%s' at %L cannot " ! "be an array", tmp_sym->name, &(tmp_sym->declared_at)); ! ! /* BIND(C) functions can not return a character string. */ ! if (bind_c_function && tmp_sym->ts.type == BT_CHARACTER) ! if (tmp_sym->ts.cl == NULL || tmp_sym->ts.cl->length == NULL ! || tmp_sym->ts.cl->length->expr_type != EXPR_CONSTANT ! || mpz_cmp_si (tmp_sym->ts.cl->length->value.integer, 1) != 0) ! gfc_error ("Return type of BIND(C) function '%s' at %L cannot " "be a character string", tmp_sym->name, &(tmp_sym->declared_at)); } /* See if the symbol has been marked as private. If it has, make sure *************** verify_bind_c_sym (gfc_symbol *tmp_sym, *** 3434,3443 **** the type is C interoperable. Errors are reported by the functions used to set/test these fields. */ ! try set_verify_bind_c_sym (gfc_symbol *tmp_sym, int num_idents) { ! try retval = SUCCESS; /* TODO: Do we need to make sure the vars aren't marked private? */ --- 3482,3491 ---- the type is C interoperable. Errors are reported by the functions used to set/test these fields. */ ! gfc_try set_verify_bind_c_sym (gfc_symbol *tmp_sym, int num_idents) { ! gfc_try retval = SUCCESS; /* TODO: Do we need to make sure the vars aren't marked private? */ *************** set_verify_bind_c_sym (gfc_symbol *tmp_s *** 3455,3464 **** /* Set the fields marking the given common block as BIND(C), including a binding label, and report any errors encountered. */ ! try set_verify_bind_c_com_block (gfc_common_head *com_block, int num_idents) { ! try retval = SUCCESS; /* destLabel, common name, typespec (which may have binding label). */ if (set_binding_label (com_block->binding_label, com_block->name, num_idents) --- 3503,3512 ---- /* Set the fields marking the given common block as BIND(C), including a binding label, and report any errors encountered. */ ! gfc_try set_verify_bind_c_com_block (gfc_common_head *com_block, int num_idents) { ! gfc_try retval = SUCCESS; /* destLabel, common name, typespec (which may have binding label). */ if (set_binding_label (com_block->binding_label, com_block->name, num_idents) *************** set_verify_bind_c_com_block (gfc_common_ *** 3475,3481 **** /* Retrieve the list of one or more identifiers that the given bind(c) attribute applies to. */ ! try get_bind_c_idents (void) { char name[GFC_MAX_SYMBOL_LEN + 1]; --- 3523,3529 ---- /* Retrieve the list of one or more identifiers that the given bind(c) attribute applies to. */ ! gfc_try get_bind_c_idents (void) { char name[GFC_MAX_SYMBOL_LEN + 1]; *************** gfc_match_prefix (gfc_typespec *ts) *** 3707,3712 **** --- 3755,3763 ---- gfc_clear_attr (¤t_attr); seen_type = 0; + gcc_assert (!gfc_matching_prefix); + gfc_matching_prefix = true; + loop: if (!seen_type && ts != NULL && gfc_match_type_spec (ts, 0) == MATCH_YES *************** loop: *** 3720,3726 **** if (gfc_match ("elemental% ") == MATCH_YES) { if (gfc_add_elemental (¤t_attr, NULL) == FAILURE) ! return MATCH_ERROR; goto loop; } --- 3771,3777 ---- if (gfc_match ("elemental% ") == MATCH_YES) { if (gfc_add_elemental (¤t_attr, NULL) == FAILURE) ! goto error; goto loop; } *************** loop: *** 3728,3734 **** if (gfc_match ("pure% ") == MATCH_YES) { if (gfc_add_pure (¤t_attr, NULL) == FAILURE) ! return MATCH_ERROR; goto loop; } --- 3779,3785 ---- if (gfc_match ("pure% ") == MATCH_YES) { if (gfc_add_pure (¤t_attr, NULL) == FAILURE) ! goto error; goto loop; } *************** loop: *** 3736,3754 **** if (gfc_match ("recursive% ") == MATCH_YES) { if (gfc_add_recursive (¤t_attr, NULL) == FAILURE) ! return MATCH_ERROR; goto loop; } /* At this point, the next item is not a prefix. */ return MATCH_YES; } /* Copy attributes matched by gfc_match_prefix() to attributes on a symbol. */ ! static try copy_prefix (symbol_attribute *dest, locus *where) { if (current_attr.pure && gfc_add_pure (dest, where) == FAILURE) --- 3787,3812 ---- if (gfc_match ("recursive% ") == MATCH_YES) { if (gfc_add_recursive (¤t_attr, NULL) == FAILURE) ! goto error; goto loop; } /* At this point, the next item is not a prefix. */ + gcc_assert (gfc_matching_prefix); + gfc_matching_prefix = false; return MATCH_YES; + + error: + gcc_assert (gfc_matching_prefix); + gfc_matching_prefix = false; + return MATCH_ERROR; } /* Copy attributes matched by gfc_match_prefix() to attributes on a symbol. */ ! static gfc_try copy_prefix (symbol_attribute *dest, locus *where) { if (current_attr.pure && gfc_add_pure (dest, where) == FAILURE) *************** match_result (gfc_symbol *function, gfc_ *** 3916,3923 **** if (gfc_get_symbol (name, NULL, &r)) return MATCH_ERROR; ! if (gfc_add_flavor (&r->attr, FL_VARIABLE, r->name, NULL) == FAILURE ! || gfc_add_result (&r->attr, r->name, NULL) == FAILURE) return MATCH_ERROR; *result = r; --- 3974,3980 ---- if (gfc_get_symbol (name, NULL, &r)) return MATCH_ERROR; ! if (gfc_add_result (&r->attr, r->name, NULL) == FAILURE) return MATCH_ERROR; *result = r; *************** gfc_match_suffix (gfc_symbol *sym, gfc_s *** 3936,3942 **** match is_bind_c; /* Found bind(c). */ match is_result; /* Found result clause. */ match found_match; /* Status of whether we've found a good match. */ ! int peek_char; /* Character we're going to peek at. */ bool allow_binding_name; /* Initialize to having found nothing. */ --- 3993,3999 ---- match is_bind_c; /* Found bind(c). */ match is_result; /* Found result clause. */ match found_match; /* Status of whether we've found a good match. */ ! char peek_char; /* Character we're going to peek at. */ bool allow_binding_name; /* Initialize to having found nothing. */ *************** gfc_match_suffix (gfc_symbol *sym, gfc_s *** 3946,3952 **** /* Get the next char to narrow between result and bind(c). */ gfc_gobble_whitespace (); ! peek_char = gfc_peek_char (); /* C binding names are not allowed for internal procedures. */ if (gfc_current_state () == COMP_CONTAINS --- 4003,4009 ---- /* Get the next char to narrow between result and bind(c). */ gfc_gobble_whitespace (); ! peek_char = gfc_peek_ascii_char (); /* C binding names are not allowed for internal procedures. */ if (gfc_current_state () == COMP_CONTAINS *************** gfc_match_suffix (gfc_symbol *sym, gfc_s *** 3997,4005 **** /* Fortran 2008 draft allows BIND(C) for internal procedures. */ if (gfc_current_state () == COMP_CONTAINS && sym->ns->proc_name->attr.flavor != FL_MODULE ! && gfc_notify_std (GFC_STD_GNU, "Extension: BIND(C) attribute at %L " ! "may not be specified for an internal procedure", ! &gfc_current_locus) == FAILURE) return MATCH_ERROR; --- 4054,4062 ---- /* Fortran 2008 draft allows BIND(C) for internal procedures. */ if (gfc_current_state () == COMP_CONTAINS && sym->ns->proc_name->attr.flavor != FL_MODULE ! && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: BIND(C) attribute " ! "at %L may not be specified for an internal " ! "procedure", &gfc_current_locus) == FAILURE) return MATCH_ERROR; *************** match_procedure_decl (void) *** 4021,4026 **** --- 4078,4084 ---- locus old_loc, entry_loc; gfc_symbol *sym, *proc_if = NULL; int num; + gfc_expr *initializer = NULL; old_loc = entry_loc = gfc_current_locus; *************** match_procedure_decl (void) *** 4035,4041 **** /* Get the type spec. for the procedure interface. */ old_loc = gfc_current_locus; m = gfc_match_type_spec (¤t_ts, 0); ! if (m == MATCH_YES || (m == MATCH_NO && gfc_peek_char () == ')')) goto got_ts; if (m == MATCH_ERROR) --- 4093,4100 ---- /* Get the type spec. for the procedure interface. */ old_loc = gfc_current_locus; m = gfc_match_type_spec (¤t_ts, 0); ! gfc_gobble_whitespace (); ! if (m == MATCH_YES || (m == MATCH_NO && gfc_peek_ascii_char () == ')')) goto got_ts; if (m == MATCH_ERROR) *************** match_procedure_decl (void) *** 4055,4065 **** /* Various interface checks. */ if (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 C1212. */ ! while (proc_if->interface) ! proc_if = proc_if->interface; if (proc_if->generic) { --- 4114,4125 ---- /* Various interface checks. */ if (proc_if) { + proc_if->refs++; /* 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 C1212. */ ! while (proc_if->ts.interface) ! proc_if = proc_if->ts.interface; if (proc_if->generic) { *************** match_procedure_decl (void) *** 4073,4080 **** return MATCH_ERROR; } /* Handle intrinsic procedures. */ ! if (gfc_intrinsic_name (proc_if->name, 0) ! || gfc_intrinsic_name (proc_if->name, 1)) proc_if->attr.intrinsic = 1; if (proc_if->attr.intrinsic && !gfc_intrinsic_actual_ok (proc_if->name, 0)) --- 4133,4142 ---- return MATCH_ERROR; } /* Handle intrinsic procedures. */ ! if (!(proc_if->attr.external || proc_if->attr.use_assoc ! || proc_if->attr.if_source == IFSRC_IFBODY) ! && (gfc_is_intrinsic (proc_if, 0, gfc_current_locus) ! || gfc_is_intrinsic (proc_if, 1, gfc_current_locus))) proc_if->attr.intrinsic = 1; if (proc_if->attr.intrinsic && !gfc_intrinsic_actual_ok (proc_if->name, 0)) *************** got_ts: *** 4137,4143 **** return MATCH_ERROR; } ! if (!sym->attr.pointer && gfc_add_external (&sym->attr, NULL) == FAILURE) return MATCH_ERROR; if (gfc_add_proc (&sym->attr, sym->name, NULL) == FAILURE) return MATCH_ERROR; --- 4199,4205 ---- return MATCH_ERROR; } ! if (gfc_add_external (&sym->attr, NULL) == FAILURE) return MATCH_ERROR; if (gfc_add_proc (&sym->attr, sym->name, NULL) == FAILURE) return MATCH_ERROR; *************** got_ts: *** 4145,4162 **** /* Set interface. */ if (proc_if != NULL) { ! sym->interface = proc_if; sym->attr.untyped = 1; } else if (current_ts.type != BT_UNKNOWN) { ! sym->interface = gfc_new_symbol ("", gfc_current_ns); ! sym->interface->ts = current_ts; ! sym->interface->attr.function = 1; ! sym->ts = sym->interface->ts; ! sym->attr.function = sym->interface->attr.function; } if (gfc_match_eos () == MATCH_YES) return MATCH_YES; if (gfc_match_char (',') != MATCH_YES) --- 4207,4258 ---- /* Set interface. */ if (proc_if != NULL) { ! sym->ts.interface = proc_if; sym->attr.untyped = 1; } else if (current_ts.type != BT_UNKNOWN) { ! sym->ts = current_ts; ! sym->ts.interface = gfc_new_symbol ("", gfc_current_ns); ! sym->ts.interface->ts = current_ts; ! sym->ts.interface->attr.function = 1; ! sym->attr.function = sym->ts.interface->attr.function; } + if (gfc_match (" =>") == MATCH_YES) + { + if (!current_attr.pointer) + { + gfc_error ("Initialization at %C isn't for a pointer variable"); + m = MATCH_ERROR; + goto cleanup; + } + + m = gfc_match_null (&initializer); + if (m == MATCH_NO) + { + gfc_error ("Pointer initialization requires a NULL() at %C"); + m = MATCH_ERROR; + } + + if (gfc_pure (NULL)) + { + gfc_error ("Initialization of pointer at %C is not allowed in " + "a PURE procedure"); + m = MATCH_ERROR; + } + + if (m != MATCH_YES) + goto cleanup; + + if (add_init_expr_to_sym (sym->name, &initializer, &gfc_current_locus) + != SUCCESS) + goto cleanup; + + } + + gfc_set_sym_referenced (sym); + if (gfc_match_eos () == MATCH_YES) return MATCH_YES; if (gfc_match_char (',') != MATCH_YES) *************** got_ts: *** 4166,4171 **** --- 4262,4272 ---- syntax: gfc_error ("Syntax error in PROCEDURE statement at %C"); return MATCH_ERROR; + + cleanup: + /* Free stuff up and return. */ + gfc_free_expr (initializer); + return m; } *************** syntax: *** 4214,4219 **** --- 4315,4322 ---- /* General matcher for PROCEDURE declarations. */ + static match match_procedure_in_type (void); + match gfc_match_procedure (void) { *************** gfc_match_procedure (void) *** 4232,4240 **** m = match_procedure_in_interface (); break; case COMP_DERIVED: ! gfc_error ("Fortran 2003: Procedure components at %C are " ! "not yet implemented in gfortran"); return MATCH_ERROR; default: return MATCH_NO; } --- 4335,4346 ---- m = match_procedure_in_interface (); break; case COMP_DERIVED: ! gfc_error ("Fortran 2003: Procedure components at %C are not yet" ! " implemented in gfortran"); return MATCH_ERROR; + case COMP_DERIVED_CONTAINS: + m = match_procedure_in_type (); + break; default: return MATCH_NO; } *************** gfc_match_procedure (void) *** 4250,4255 **** --- 4356,4377 ---- } + /* Warn if a matched procedure has the same name as an intrinsic; this is + simply a wrapper around gfc_warn_intrinsic_shadow that interprets the current + parser-state-stack to find out whether we're in a module. */ + + static void + warn_intrinsic_shadow (const gfc_symbol* sym, bool func) + { + bool in_module; + + in_module = (gfc_state_stack->previous + && gfc_state_stack->previous->state == COMP_MODULE); + + gfc_warn_intrinsic_shadow (sym, in_module, func); + } + + /* Match a function declaration. */ match *************** gfc_match_function_decl (void) *** 4374,4379 **** --- 4496,4504 ---- sym->result = result; } + /* Warn if this procedure has the same name as an intrinsic. */ + warn_intrinsic_shadow (sym, true); + return MATCH_YES; } *************** gfc_match_entry (void) *** 4527,4533 **** /* Check what next non-whitespace character is so we can tell if there is the required parens if we have a BIND(C). */ gfc_gobble_whitespace (); ! peek_char = gfc_peek_char (); if (state == COMP_SUBROUTINE) { --- 4652,4658 ---- /* Check what next non-whitespace character is so we can tell if there is the required parens if we have a BIND(C). */ gfc_gobble_whitespace (); ! peek_char = gfc_peek_ascii_char (); if (state == COMP_SUBROUTINE) { *************** gfc_match_subroutine (void) *** 4683,4689 **** /* Check what next non-whitespace character is so we can tell if there is the required parens if we have a BIND(C). */ gfc_gobble_whitespace (); ! peek_char = gfc_peek_char (); if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE) return MATCH_ERROR; --- 4808,4814 ---- /* Check what next non-whitespace character is so we can tell if there is the required parens if we have a BIND(C). */ gfc_gobble_whitespace (); ! peek_char = gfc_peek_ascii_char (); if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE) return MATCH_ERROR; *************** gfc_match_subroutine (void) *** 4730,4738 **** /* The following is allowed in the Fortran 2008 draft. */ if (gfc_current_state () == COMP_CONTAINS && sym->ns->proc_name->attr.flavor != FL_MODULE ! && gfc_notify_std (GFC_STD_GNU, "Extension: BIND(C) attribute at " ! "%L may not be specified for an internal procedure", ! &gfc_current_locus) == FAILURE) return MATCH_ERROR; --- 4855,4863 ---- /* The following is allowed in the Fortran 2008 draft. */ if (gfc_current_state () == COMP_CONTAINS && sym->ns->proc_name->attr.flavor != FL_MODULE ! && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: BIND(C) attribute " ! "at %L may not be specified for an internal " ! "procedure", &gfc_current_locus) == FAILURE) return MATCH_ERROR; *************** gfc_match_subroutine (void) *** 4755,4760 **** --- 4880,4888 ---- if (copy_prefix (&sym->attr, &sym->declared_at) == FAILURE) return MATCH_ERROR; + /* Warn if it has the same name as an intrinsic. */ + warn_intrinsic_shadow (sym, false); + return MATCH_YES; } *************** gfc_match_end (gfc_statement *st) *** 4970,4976 **** block_name = gfc_current_block () == NULL ? NULL : gfc_current_block ()->name; ! if (state == COMP_CONTAINS) { state = gfc_state_stack->previous->state; block_name = gfc_state_stack->previous->sym == NULL --- 5098,5104 ---- block_name = gfc_current_block () == NULL ? NULL : gfc_current_block ()->name; ! if (state == COMP_CONTAINS || state == COMP_DERIVED_CONTAINS) { state = gfc_state_stack->previous->state; block_name = gfc_state_stack->previous->sym == NULL *************** gfc_match_end (gfc_statement *st) *** 5017,5022 **** --- 5145,5151 ---- break; case COMP_DERIVED: + case COMP_DERIVED_CONTAINS: *st = ST_END_TYPE; target = " type"; eos_ok = 0; *************** attr_decl1 (void) *** 5203,5209 **** /* Update symbol table. DIMENSION attribute is set in gfc_set_array_spec(). */ if (current_attr.dimension == 0 ! && gfc_copy_attr (&sym->attr, ¤t_attr, NULL) == FAILURE) { m = MATCH_ERROR; goto cleanup; --- 5332,5338 ---- /* Update symbol table. DIMENSION attribute is set in gfc_set_array_spec(). */ if (current_attr.dimension == 0 ! && gfc_copy_attr (&sym->attr, ¤t_attr, &var_locus) == FAILURE) { m = MATCH_ERROR; goto cleanup; *************** match *** 5483,5489 **** gfc_match_pointer (void) { gfc_gobble_whitespace (); ! if (gfc_peek_char () == '(') { if (!gfc_option.flag_cray_pointer) { --- 5612,5618 ---- gfc_match_pointer (void) { gfc_gobble_whitespace (); ! if (gfc_peek_ascii_char () == '(') { if (!gfc_option.flag_cray_pointer) { *************** access_attr_decl (gfc_statement st) *** 5543,5549 **** interface_type type; gfc_user_op *uop; gfc_symbol *sym; ! gfc_intrinsic_op operator; match m; if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO) --- 5672,5678 ---- interface_type type; gfc_user_op *uop; gfc_symbol *sym; ! gfc_intrinsic_op op; match m; if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO) *************** access_attr_decl (gfc_statement st) *** 5551,5557 **** for (;;) { ! m = gfc_match_generic_spec (&type, name, &operator); if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR) --- 5680,5686 ---- for (;;) { ! m = gfc_match_generic_spec (&type, name, &op); if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR) *************** access_attr_decl (gfc_statement st) *** 5575,5589 **** break; case INTERFACE_INTRINSIC_OP: ! if (gfc_current_ns->operator_access[operator] == ACCESS_UNKNOWN) { ! gfc_current_ns->operator_access[operator] = (st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE; } else { gfc_error ("Access specification of the %s operator at %C has " ! "already been specified", gfc_op2string (operator)); goto done; } --- 5704,5718 ---- break; case INTERFACE_INTRINSIC_OP: ! if (gfc_current_ns->operator_access[op] == ACCESS_UNKNOWN) { ! gfc_current_ns->operator_access[op] = (st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE; } else { gfc_error ("Access specification of the %s operator at %C has " ! "already been specified", gfc_op2string (op)); goto done; } *************** syntax: *** 5683,5689 **** /* The PRIVATE statement is a bit weird in that it can be an attribute ! declaration, but also works as a standlone statement inside of a type declaration or a module. */ match --- 5812,5818 ---- /* The PRIVATE statement is a bit weird in that it can be an attribute ! declaration, but also works as a standalone statement inside of a type declaration or a module. */ match *************** gfc_match_private (gfc_statement *st) *** 5694,5702 **** return MATCH_NO; if (gfc_current_state () != COMP_MODULE ! && (gfc_current_state () != COMP_DERIVED ! || !gfc_state_stack->previous ! || gfc_state_stack->previous->state != COMP_MODULE)) { gfc_error ("PRIVATE statement at %C is only allowed in the " "specification part of a module"); --- 5823,5834 ---- return MATCH_NO; if (gfc_current_state () != COMP_MODULE ! && !(gfc_current_state () == COMP_DERIVED ! && gfc_state_stack->previous ! && gfc_state_stack->previous->state == COMP_MODULE) ! && !(gfc_current_state () == COMP_DERIVED_CONTAINS ! && gfc_state_stack->previous && gfc_state_stack->previous->previous ! && gfc_state_stack->previous->previous->state == COMP_MODULE)) { gfc_error ("PRIVATE statement at %C is only allowed in the " "specification part of a module"); *************** do_parm (void) *** 5805,5814 **** && sym->ts.cl->length != NULL && sym->ts.cl->length->expr_type == EXPR_CONSTANT && init->expr_type == EXPR_CONSTANT ! && init->ts.type == BT_CHARACTER ! && init->ts.kind == 1) gfc_set_constant_character_len ( ! mpz_get_si (sym->ts.cl->length->value.integer), init, false); sym->value = init; return MATCH_YES; --- 5937,5963 ---- && sym->ts.cl->length != NULL && sym->ts.cl->length->expr_type == EXPR_CONSTANT && init->expr_type == EXPR_CONSTANT ! && init->ts.type == BT_CHARACTER) gfc_set_constant_character_len ( ! mpz_get_si (sym->ts.cl->length->value.integer), init, -1); ! else if (sym->ts.type == BT_CHARACTER && sym->ts.cl != NULL ! && sym->ts.cl->length == NULL) ! { ! int clen; ! if (init->expr_type == EXPR_CONSTANT) ! { ! clen = init->value.character.length; ! sym->ts.cl->length = gfc_int_expr (clen); ! } ! else if (init->expr_type == EXPR_ARRAY) ! { ! gfc_expr *p = init->value.constructor->expr; ! clen = p->value.character.length; ! sym->ts.cl->length = gfc_int_expr (clen); ! } ! else if (init->ts.cl && init->ts.cl->length) ! sym->ts.cl->length = gfc_copy_expr (sym->value->ts.cl->length); ! } sym->value = init; return MATCH_YES; *************** syntax: *** 6124,6129 **** --- 6273,6321 ---- } + /* Check a derived type that is being extended. */ + static gfc_symbol* + check_extended_derived_type (char *name) + { + gfc_symbol *extended; + + if (gfc_find_symbol (name, gfc_current_ns, 1, &extended)) + { + gfc_error ("Ambiguous symbol in TYPE definition at %C"); + return NULL; + } + + if (!extended) + { + gfc_error ("No such symbol in TYPE definition at %C"); + return NULL; + } + + if (extended->attr.flavor != FL_DERIVED) + { + gfc_error ("'%s' in EXTENDS expression at %C is not a " + "derived type", name); + return NULL; + } + + if (extended->attr.is_bind_c) + { + gfc_error ("'%s' cannot be extended at %C because it " + "is BIND(C)", extended->name); + return NULL; + } + + if (extended->attr.sequence) + { + gfc_error ("'%s' cannot be extended at %C because it " + "is a SEQUENCE type", extended->name); + return NULL; + } + + return extended; + } + + /* Match the optional attribute specifiers for a type declaration. Return MATCH_ERROR if an error is encountered in one of the handled attributes (public, private, bind(c)), MATCH_NO if what's found is *************** syntax: *** 6131,6137 **** checking on attribute conflicts needs to be done. */ match ! gfc_get_type_attr_spec (symbol_attribute *attr) { /* See if the derived type is marked as private. */ if (gfc_match (" , private") == MATCH_YES) --- 6323,6329 ---- checking on attribute conflicts needs to be done. */ match ! gfc_get_type_attr_spec (symbol_attribute *attr, char *name) { /* See if the derived type is marked as private. */ if (gfc_match (" , private") == MATCH_YES) *************** gfc_get_type_attr_spec (symbol_attribute *** 6158,6164 **** if (gfc_add_access (attr, ACCESS_PUBLIC, NULL, NULL) == FAILURE) return MATCH_ERROR; } ! else if (gfc_match(" , bind ( c )") == MATCH_YES) { /* If the type is defined to be bind(c) it then needs to make sure that all fields are interoperable. This will --- 6350,6356 ---- if (gfc_add_access (attr, ACCESS_PUBLIC, NULL, NULL) == FAILURE) return MATCH_ERROR; } ! else if (gfc_match (" , bind ( c )") == MATCH_YES) { /* If the type is defined to be bind(c) it then needs to make sure that all fields are interoperable. This will *************** gfc_get_type_attr_spec (symbol_attribute *** 6169,6174 **** --- 6361,6380 ---- /* TODO: attr conflicts need to be checked, probably in symbol.c. */ } + else if (gfc_match (" , abstract") == MATCH_YES) + { + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ABSTRACT type at %C") + == FAILURE) + return MATCH_ERROR; + + if (gfc_add_abstract (attr, &gfc_current_locus) == FAILURE) + return MATCH_ERROR; + } + else if (name && gfc_match(" , extends ( %n )", name) == MATCH_YES) + { + if (gfc_add_extension (attr, &gfc_current_locus) == FAILURE) + return MATCH_ERROR; + } else return MATCH_NO; *************** match *** 6185,6192 **** --- 6391,6400 ---- gfc_match_derived_decl (void) { char name[GFC_MAX_SYMBOL_LEN + 1]; + char parent[GFC_MAX_SYMBOL_LEN + 1]; symbol_attribute attr; gfc_symbol *sym; + gfc_symbol *extended; match m; match is_type_attr_spec = MATCH_NO; bool seen_attr = false; *************** gfc_match_derived_decl (void) *** 6194,6210 **** if (gfc_current_state () == COMP_DERIVED) return MATCH_NO; gfc_clear_attr (&attr); do { ! is_type_attr_spec = gfc_get_type_attr_spec (&attr); if (is_type_attr_spec == MATCH_ERROR) return MATCH_ERROR; if (is_type_attr_spec == MATCH_YES) seen_attr = true; } while (is_type_attr_spec == MATCH_YES); if (gfc_match (" ::") != MATCH_YES && seen_attr) { gfc_error ("Expected :: in TYPE definition at %C"); --- 6402,6430 ---- if (gfc_current_state () == COMP_DERIVED) return MATCH_NO; + name[0] = '\0'; + parent[0] = '\0'; gfc_clear_attr (&attr); + extended = NULL; do { ! is_type_attr_spec = gfc_get_type_attr_spec (&attr, parent); if (is_type_attr_spec == MATCH_ERROR) return MATCH_ERROR; if (is_type_attr_spec == MATCH_YES) seen_attr = true; } while (is_type_attr_spec == MATCH_YES); + /* Deal with derived type extensions. The extension attribute has + been added to 'attr' but now the parent type must be found and + checked. */ + if (parent[0]) + extended = check_extended_derived_type (parent); + + if (parent[0] && !extended) + return MATCH_ERROR; + if (gfc_match (" ::") != MATCH_YES && seen_attr) { gfc_error ("Expected :: in TYPE definition at %C"); *************** gfc_match_derived_decl (void) *** 6237,6243 **** components. The ways this can happen is via a function definition, an INTRINSIC statement or a subtype in another derived type that is a pointer. The first part of the AND clause ! is true if a the symbol is not the return value of a function. */ if (sym->attr.flavor != FL_DERIVED && gfc_add_flavor (&sym->attr, FL_DERIVED, sym->name, NULL) == FAILURE) return MATCH_ERROR; --- 6457,6463 ---- components. The ways this can happen is via a function definition, an INTRINSIC statement or a subtype in another derived type that is a pointer. The first part of the AND clause ! is true if the symbol is not the return value of a function. */ if (sym->attr.flavor != FL_DERIVED && gfc_add_flavor (&sym->attr, FL_DERIVED, sym->name, NULL) == FAILURE) return MATCH_ERROR; *************** gfc_match_derived_decl (void) *** 6257,6262 **** --- 6477,6511 ---- if (attr.is_bind_c != 0) sym->attr.is_bind_c = attr.is_bind_c; + /* Construct the f2k_derived namespace if it is not yet there. */ + if (!sym->f2k_derived) + sym->f2k_derived = gfc_get_namespace (NULL, 0); + + if (extended && !sym->components) + { + gfc_component *p; + gfc_symtree *st; + + /* Add the extended derived type as the first component. */ + gfc_add_component (sym, parent, &p); + sym->attr.extension = attr.extension; + extended->refs++; + gfc_set_sym_referenced (extended); + + p->ts.type = BT_DERIVED; + p->ts.derived = extended; + p->initializer = gfc_default_initializer (&p->ts); + + /* Provide the links between the extended type and its extension. */ + if (!extended->f2k_derived) + extended->f2k_derived = gfc_get_namespace (NULL, 0); + st = gfc_new_symtree (&extended->f2k_derived->sym_root, sym->name); + st->n.sym = sym; + } + + /* Take over the ABSTRACT attribute. */ + sym->attr.abstract = attr.abstract; + gfc_new_block = sym; return MATCH_YES; *************** gfc_match_derived_decl (void) *** 6270,6276 **** is the case. Since there is no bounds-checking for Cray Pointees, this will be okay. */ ! try gfc_mod_pointee_as (gfc_array_spec *as) { as->cray_pointee = true; /* This will be useful to know later. */ --- 6519,6525 ---- is the case. Since there is no bounds-checking for Cray Pointees, this will be okay. */ ! gfc_try gfc_mod_pointee_as (gfc_array_spec *as) { as->cray_pointee = true; /* This will be useful to know later. */ *************** enumerator_decl (void) *** 6324,6330 **** gfc_symbol *sym; locus var_locus; match m; ! try t; locus old_locus; initializer = NULL; --- 6573,6579 ---- gfc_symbol *sym; locus var_locus; match m; ! gfc_try t; locus old_locus; initializer = NULL; *************** match *** 6407,6413 **** gfc_match_enumerator_def (void) { match m; ! try t; gfc_clear_ts (¤t_ts); --- 6656,6662 ---- gfc_match_enumerator_def (void) { match m; ! gfc_try t; gfc_clear_ts (¤t_ts); *************** cleanup: *** 6467,6469 **** --- 6716,7236 ---- } + + /* Match binding attributes. */ + + static match + match_binding_attributes (gfc_typebound_proc* ba, bool generic) + { + bool found_passing = false; + match m; + + /* Intialize to defaults. Do so even before the MATCH_NO check so that in + this case the defaults are in there. */ + ba->access = ACCESS_UNKNOWN; + ba->pass_arg = NULL; + ba->pass_arg_num = 0; + ba->nopass = 0; + ba->non_overridable = 0; + + /* If we find a comma, we believe there are binding attributes. */ + if (gfc_match_char (',') == MATCH_NO) + { + ba->access = gfc_typebound_default_access; + return MATCH_NO; + } + + do + { + /* Access specifier. */ + + m = gfc_match (" public"); + if (m == MATCH_ERROR) + goto error; + if (m == MATCH_YES) + { + if (ba->access != ACCESS_UNKNOWN) + { + gfc_error ("Duplicate access-specifier at %C"); + goto error; + } + + ba->access = ACCESS_PUBLIC; + continue; + } + + m = gfc_match (" private"); + if (m == MATCH_ERROR) + goto error; + if (m == MATCH_YES) + { + if (ba->access != ACCESS_UNKNOWN) + { + gfc_error ("Duplicate access-specifier at %C"); + goto error; + } + + ba->access = ACCESS_PRIVATE; + continue; + } + + /* If inside GENERIC, the following is not allowed. */ + if (!generic) + { + + /* NOPASS flag. */ + m = gfc_match (" nopass"); + if (m == MATCH_ERROR) + goto error; + if (m == MATCH_YES) + { + if (found_passing) + { + gfc_error ("Binding attributes already specify passing," + " illegal NOPASS at %C"); + goto error; + } + + found_passing = true; + ba->nopass = 1; + continue; + } + + /* NON_OVERRIDABLE flag. */ + m = gfc_match (" non_overridable"); + if (m == MATCH_ERROR) + goto error; + if (m == MATCH_YES) + { + if (ba->non_overridable) + { + gfc_error ("Duplicate NON_OVERRIDABLE at %C"); + goto error; + } + + ba->non_overridable = 1; + continue; + } + + /* DEFERRED flag. */ + /* TODO: Handle really once implemented. */ + m = gfc_match (" deferred"); + if (m == MATCH_ERROR) + goto error; + if (m == MATCH_YES) + { + gfc_error ("DEFERRED not yet implemented at %C"); + goto error; + } + + /* PASS possibly including argument. */ + m = gfc_match (" pass"); + if (m == MATCH_ERROR) + goto error; + if (m == MATCH_YES) + { + char arg[GFC_MAX_SYMBOL_LEN + 1]; + + if (found_passing) + { + gfc_error ("Binding attributes already specify passing," + " illegal PASS at %C"); + goto error; + } + + m = gfc_match (" ( %n )", arg); + if (m == MATCH_ERROR) + goto error; + if (m == MATCH_YES) + ba->pass_arg = xstrdup (arg); + gcc_assert ((m == MATCH_YES) == (ba->pass_arg != NULL)); + + found_passing = true; + ba->nopass = 0; + continue; + } + + } + + /* Nothing matching found. */ + if (generic) + gfc_error ("Expected access-specifier at %C"); + else + gfc_error ("Expected binding attribute at %C"); + goto error; + } + while (gfc_match_char (',') == MATCH_YES); + + if (ba->access == ACCESS_UNKNOWN) + ba->access = gfc_typebound_default_access; + + return MATCH_YES; + + error: + gfc_free (ba->pass_arg); + return MATCH_ERROR; + } + + + /* Match a PROCEDURE specific binding inside a derived type. */ + + static match + match_procedure_in_type (void) + { + char name[GFC_MAX_SYMBOL_LEN + 1]; + char target_buf[GFC_MAX_SYMBOL_LEN + 1]; + char* target; + gfc_typebound_proc* tb; + bool seen_colons; + bool seen_attrs; + match m; + gfc_symtree* stree; + gfc_namespace* ns; + gfc_symbol* block; + + /* Check current state. */ + gcc_assert (gfc_state_stack->state == COMP_DERIVED_CONTAINS); + block = gfc_state_stack->previous->sym; + gcc_assert (block); + + /* TODO: Really implement PROCEDURE(interface). */ + if (gfc_match (" (") == MATCH_YES) + { + gfc_error ("PROCEDURE(interface) at %C is not yet implemented"); + return MATCH_ERROR; + } + + /* Construct the data structure. */ + tb = gfc_get_typebound_proc (); + tb->where = gfc_current_locus; + tb->is_generic = 0; + + /* Match binding attributes. */ + m = match_binding_attributes (tb, false); + if (m == MATCH_ERROR) + return m; + seen_attrs = (m == MATCH_YES); + + /* Match the colons. */ + m = gfc_match (" ::"); + if (m == MATCH_ERROR) + return m; + seen_colons = (m == MATCH_YES); + if (seen_attrs && !seen_colons) + { + gfc_error ("Expected '::' after binding-attributes at %C"); + return MATCH_ERROR; + } + + /* Match the binding name. */ + m = gfc_match_name (name); + if (m == MATCH_ERROR) + return m; + if (m == MATCH_NO) + { + gfc_error ("Expected binding name at %C"); + return MATCH_ERROR; + } + + /* Try to match the '=> target', if it's there. */ + target = NULL; + m = gfc_match (" =>"); + if (m == MATCH_ERROR) + return m; + if (m == MATCH_YES) + { + if (!seen_colons) + { + gfc_error ("'::' needed in PROCEDURE binding with explicit target" + " at %C"); + return MATCH_ERROR; + } + + m = gfc_match_name (target_buf); + if (m == MATCH_ERROR) + return m; + if (m == MATCH_NO) + { + gfc_error ("Expected binding target after '=>' at %C"); + return MATCH_ERROR; + } + target = target_buf; + } + + /* Now we should have the end. */ + m = gfc_match_eos (); + if (m == MATCH_ERROR) + return m; + if (m == MATCH_NO) + { + gfc_error ("Junk after PROCEDURE declaration at %C"); + return MATCH_ERROR; + } + + /* If no target was found, it has the same name as the binding. */ + if (!target) + target = name; + + /* Get the namespace to insert the symbols into. */ + ns = block->f2k_derived; + gcc_assert (ns); + + /* See if we already have a binding with this name in the symtree which would + be an error. If a GENERIC already targetted this binding, it may be + already there but then typebound is still NULL. */ + stree = gfc_find_symtree (ns->sym_root, name); + if (stree && stree->typebound) + { + gfc_error ("There's already a procedure with binding name '%s' for the" + " derived type '%s' at %C", name, block->name); + return MATCH_ERROR; + } + + /* Insert it and set attributes. */ + if (gfc_get_sym_tree (name, ns, &stree)) + return MATCH_ERROR; + if (gfc_get_sym_tree (target, gfc_current_ns, &tb->u.specific)) + return MATCH_ERROR; + gfc_set_sym_referenced (tb->u.specific->n.sym); + stree->typebound = tb; + + return MATCH_YES; + } + + + /* Match a GENERIC procedure binding inside a derived type. */ + + match + gfc_match_generic (void) + { + char name[GFC_MAX_SYMBOL_LEN + 1]; + gfc_symbol* block; + gfc_typebound_proc tbattr; /* Used for match_binding_attributes. */ + gfc_typebound_proc* tb; + gfc_symtree* st; + gfc_namespace* ns; + match m; + + /* Check current state. */ + if (gfc_current_state () == COMP_DERIVED) + { + gfc_error ("GENERIC at %C must be inside a derived-type CONTAINS"); + return MATCH_ERROR; + } + if (gfc_current_state () != COMP_DERIVED_CONTAINS) + return MATCH_NO; + block = gfc_state_stack->previous->sym; + ns = block->f2k_derived; + gcc_assert (block && ns); + + /* See if we get an access-specifier. */ + m = match_binding_attributes (&tbattr, true); + if (m == MATCH_ERROR) + goto error; + + /* Now the colons, those are required. */ + if (gfc_match (" ::") != MATCH_YES) + { + gfc_error ("Expected '::' at %C"); + goto error; + } + + /* The binding name and =>. */ + m = gfc_match (" %n =>", name); + if (m == MATCH_ERROR) + return MATCH_ERROR; + if (m == MATCH_NO) + { + gfc_error ("Expected generic name at %C"); + goto error; + } + + /* If there's already something with this name, check that it is another + GENERIC and then extend that rather than build a new node. */ + st = gfc_find_symtree (ns->sym_root, name); + if (st) + { + if (!st->typebound || !st->typebound->is_generic) + { + gfc_error ("There's already a non-generic procedure with binding name" + " '%s' for the derived type '%s' at %C", + name, block->name); + goto error; + } + + tb = st->typebound; + if (tb->access != tbattr.access) + { + gfc_error ("Binding at %C must have the same access as already" + " defined binding '%s'", name); + goto error; + } + } + else + { + if (gfc_get_sym_tree (name, ns, &st)) + return MATCH_ERROR; + + st->typebound = tb = gfc_get_typebound_proc (); + tb->where = gfc_current_locus; + tb->access = tbattr.access; + tb->is_generic = 1; + tb->u.generic = NULL; + } + + /* Now, match all following names as specific targets. */ + do + { + gfc_symtree* target_st; + gfc_tbp_generic* target; + + m = gfc_match_name (name); + if (m == MATCH_ERROR) + goto error; + if (m == MATCH_NO) + { + gfc_error ("Expected specific binding name at %C"); + goto error; + } + + if (gfc_get_sym_tree (name, ns, &target_st)) + goto error; + + /* See if this is a duplicate specification. */ + for (target = tb->u.generic; target; target = target->next) + if (target_st == target->specific_st) + { + gfc_error ("'%s' already defined as specific binding for the" + " generic '%s' at %C", name, st->n.sym->name); + goto error; + } + + gfc_set_sym_referenced (target_st->n.sym); + + target = gfc_get_tbp_generic (); + target->specific_st = target_st; + target->specific = NULL; + target->next = tb->u.generic; + tb->u.generic = target; + } + while (gfc_match (" ,") == MATCH_YES); + + /* Here should be the end. */ + if (gfc_match_eos () != MATCH_YES) + { + gfc_error ("Junk after GENERIC binding at %C"); + goto error; + } + + return MATCH_YES; + + error: + return MATCH_ERROR; + } + + + /* Match a FINAL declaration inside a derived type. */ + + match + gfc_match_final_decl (void) + { + char name[GFC_MAX_SYMBOL_LEN + 1]; + gfc_symbol* sym; + match m; + gfc_namespace* module_ns; + bool first, last; + gfc_symbol* block; + + if (gfc_state_stack->state != COMP_DERIVED_CONTAINS) + { + gfc_error ("FINAL declaration at %C must be inside a derived type " + "CONTAINS section"); + return MATCH_ERROR; + } + + block = gfc_state_stack->previous->sym; + gcc_assert (block); + + if (!gfc_state_stack->previous || !gfc_state_stack->previous->previous + || gfc_state_stack->previous->previous->state != COMP_MODULE) + { + gfc_error ("Derived type declaration with FINAL at %C must be in the" + " specification part of a MODULE"); + return MATCH_ERROR; + } + + module_ns = gfc_current_ns; + gcc_assert (module_ns); + gcc_assert (module_ns->proc_name->attr.flavor == FL_MODULE); + + /* Match optional ::, don't care about MATCH_YES or MATCH_NO. */ + if (gfc_match (" ::") == MATCH_ERROR) + return MATCH_ERROR; + + /* Match the sequence of procedure names. */ + first = true; + last = false; + do + { + gfc_finalizer* f; + + if (first && gfc_match_eos () == MATCH_YES) + { + gfc_error ("Empty FINAL at %C"); + return MATCH_ERROR; + } + + m = gfc_match_name (name); + if (m == MATCH_NO) + { + gfc_error ("Expected module procedure name at %C"); + return MATCH_ERROR; + } + else if (m != MATCH_YES) + return MATCH_ERROR; + + if (gfc_match_eos () == MATCH_YES) + last = true; + if (!last && gfc_match_char (',') != MATCH_YES) + { + gfc_error ("Expected ',' at %C"); + return MATCH_ERROR; + } + + if (gfc_get_symbol (name, module_ns, &sym)) + { + gfc_error ("Unknown procedure name \"%s\" at %C", name); + return MATCH_ERROR; + } + + /* Mark the symbol as module procedure. */ + if (sym->attr.proc != PROC_MODULE + && gfc_add_procedure (&sym->attr, PROC_MODULE, + sym->name, NULL) == FAILURE) + return MATCH_ERROR; + + /* Check if we already have this symbol in the list, this is an error. */ + for (f = block->f2k_derived->finalizers; f; f = f->next) + if (f->proc_sym == sym) + { + gfc_error ("'%s' at %C is already defined as FINAL procedure!", + name); + return MATCH_ERROR; + } + + /* Add this symbol to the list of finalizers. */ + gcc_assert (block->f2k_derived); + ++sym->refs; + f = XCNEW (gfc_finalizer); + f->proc_sym = sym; + f->proc_tree = NULL; + f->where = gfc_current_locus; + f->next = block->f2k_derived->finalizers; + block->f2k_derived->finalizers = f; + + first = false; + } + while (!last); + + return MATCH_YES; + } diff -Nrcpad gcc-4.3.3/gcc/fortran/dependency.c gcc-4.4.0/gcc/fortran/dependency.c *** gcc-4.3.3/gcc/fortran/dependency.c Wed Jan 14 20:53:18 2009 --- gcc-4.4.0/gcc/fortran/dependency.c Fri Jan 9 23:47:55 2009 *************** *** 1,5 **** /* Dependency analysis ! Copyright (C) 2000, 2001, 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook --- 1,5 ---- /* Dependency analysis ! Copyright (C) 2000, 2001, 2002, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Paul Brook *************** typedef enum *** 37,43 **** { GFC_DEP_ERROR, GFC_DEP_EQUAL, /* Identical Ranges. */ ! GFC_DEP_FORWARD, /* eg. a(1:3), a(2:4). */ GFC_DEP_OVERLAP, /* May overlap in some other way. */ GFC_DEP_NODEP /* Distinct ranges. */ } --- 37,43 ---- { GFC_DEP_ERROR, GFC_DEP_EQUAL, /* Identical Ranges. */ ! GFC_DEP_FORWARD, /* e.g., a(1:3), a(2:4). */ GFC_DEP_OVERLAP, /* May overlap in some other way. */ GFC_DEP_NODEP /* Distinct ranges. */ } *************** gfc_dep_compare_expr (gfc_expr *e1, gfc_ *** 76,90 **** int i; if (e1->expr_type == EXPR_OP ! && (e1->value.op.operator == INTRINSIC_UPLUS ! || e1->value.op.operator == INTRINSIC_PARENTHESES)) return gfc_dep_compare_expr (e1->value.op.op1, e2); if (e2->expr_type == EXPR_OP ! && (e2->value.op.operator == INTRINSIC_UPLUS ! || e2->value.op.operator == INTRINSIC_PARENTHESES)) return gfc_dep_compare_expr (e1, e2->value.op.op1); ! if (e1->expr_type == EXPR_OP && e1->value.op.operator == INTRINSIC_PLUS) { /* Compare X+C vs. X. */ if (e1->value.op.op2->expr_type == EXPR_CONSTANT --- 76,90 ---- int i; if (e1->expr_type == EXPR_OP ! && (e1->value.op.op == INTRINSIC_UPLUS ! || e1->value.op.op == INTRINSIC_PARENTHESES)) return gfc_dep_compare_expr (e1->value.op.op1, e2); if (e2->expr_type == EXPR_OP ! && (e2->value.op.op == INTRINSIC_UPLUS ! || e2->value.op.op == INTRINSIC_PARENTHESES)) return gfc_dep_compare_expr (e1, e2->value.op.op1); ! if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS) { /* Compare X+C vs. X. */ if (e1->value.op.op2->expr_type == EXPR_CONSTANT *************** gfc_dep_compare_expr (gfc_expr *e1, gfc_ *** 93,99 **** return mpz_sgn (e1->value.op.op2->value.integer); /* Compare P+Q vs. R+S. */ ! if (e2->expr_type == EXPR_OP && e2->value.op.operator == INTRINSIC_PLUS) { int l, r; --- 93,99 ---- return mpz_sgn (e1->value.op.op2->value.integer); /* Compare P+Q vs. R+S. */ ! if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS) { int l, r; *************** gfc_dep_compare_expr (gfc_expr *e1, gfc_ *** 126,132 **** } /* Compare X vs. X+C. */ ! if (e2->expr_type == EXPR_OP && e2->value.op.operator == INTRINSIC_PLUS) { if (e2->value.op.op2->expr_type == EXPR_CONSTANT && e2->value.op.op2->ts.type == BT_INTEGER --- 126,132 ---- } /* Compare X vs. X+C. */ ! if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS) { if (e2->value.op.op2->expr_type == EXPR_CONSTANT && e2->value.op.op2->ts.type == BT_INTEGER *************** gfc_dep_compare_expr (gfc_expr *e1, gfc_ *** 135,141 **** } /* Compare X-C vs. X. */ ! if (e1->expr_type == EXPR_OP && e1->value.op.operator == INTRINSIC_MINUS) { if (e1->value.op.op2->expr_type == EXPR_CONSTANT && e1->value.op.op2->ts.type == BT_INTEGER --- 135,141 ---- } /* Compare X-C vs. X. */ ! if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_MINUS) { if (e1->value.op.op2->expr_type == EXPR_CONSTANT && e1->value.op.op2->ts.type == BT_INTEGER *************** gfc_dep_compare_expr (gfc_expr *e1, gfc_ *** 143,149 **** return -mpz_sgn (e1->value.op.op2->value.integer); /* Compare P-Q vs. R-S. */ ! if (e2->expr_type == EXPR_OP && e2->value.op.operator == INTRINSIC_MINUS) { int l, r; --- 143,149 ---- return -mpz_sgn (e1->value.op.op2->value.integer); /* Compare P-Q vs. R-S. */ ! if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS) { int l, r; *************** gfc_dep_compare_expr (gfc_expr *e1, gfc_ *** 163,169 **** } /* Compare X vs. X-C. */ ! if (e2->expr_type == EXPR_OP && e2->value.op.operator == INTRINSIC_MINUS) { if (e2->value.op.op2->expr_type == EXPR_CONSTANT && e2->value.op.op2->ts.type == BT_INTEGER --- 163,169 ---- } /* Compare X vs. X-C. */ ! if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS) { if (e2->value.op.op2->expr_type == EXPR_CONSTANT && e2->value.op.op2->ts.type == BT_INTEGER *************** gfc_dep_compare_expr (gfc_expr *e1, gfc_ *** 196,202 **** case EXPR_OP: /* Intrinsic operators are the same if their operands are the same. */ ! if (e1->value.op.operator != e2->value.op.operator) return -2; if (e1->value.op.op2 == 0) { --- 196,202 ---- case EXPR_OP: /* Intrinsic operators are the same if their operands are the same. */ ! if (e1->value.op.op != e2->value.op.op) return -2; if (e1->value.op.op2 == 0) { *************** gfc_ref_needs_temporary_p (gfc_ref *ref) *** 422,439 **** } ! static int gfc_is_data_pointer (gfc_expr *e) { gfc_ref *ref; ! if (e->expr_type != EXPR_VARIABLE) return 0; if (e->symtree->n.sym->attr.pointer) return 1; for (ref = e->ref; ref; ref = ref->next) ! if (ref->type == REF_COMPONENT && ref->u.c.component->pointer) return 1; return 0; --- 422,443 ---- } ! int gfc_is_data_pointer (gfc_expr *e) { gfc_ref *ref; ! if (e->expr_type != EXPR_VARIABLE && e->expr_type != EXPR_FUNCTION) return 0; + /* No subreference if it is a function */ + gcc_assert (e->expr_type == EXPR_VARIABLE || !e->ref); + if (e->symtree->n.sym->attr.pointer) return 1; + for (ref = e->ref; ref; ref = ref->next) ! if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer) return 1; return 0; *************** gfc_check_fncall_dependency (gfc_expr *o *** 603,609 **** /* Return 1 if e1 and e2 are equivalenced arrays, either ! directly or indirectly; ie. equivalence (a,b) for a and b or equivalence (a,c),(b,c). This function uses the equiv_ lists, generated in trans-common(add_equivalences), that are guaranteed to pick up indirect equivalences. We explicitly --- 607,613 ---- /* Return 1 if e1 and e2 are equivalenced arrays, either ! directly or indirectly; i.e., equivalence (a,b) for a and b or equivalence (a,c),(b,c). This function uses the equiv_ lists, generated in trans-common(add_equivalences), that are guaranteed to pick up indirect equivalences. We explicitly *************** gfc_dep_resolver (gfc_ref *lref, gfc_ref *** 1259,1265 **** while (lref && rref) { /* We're resolving from the same base symbol, so both refs should be ! the same type. We traverse the reference chain intil we find ranges that are not equal. */ gcc_assert (lref->type == rref->type); switch (lref->type) --- 1263,1269 ---- while (lref && rref) { /* We're resolving from the same base symbol, so both refs should be ! the same type. We traverse the reference chain until we find ranges that are not equal. */ gcc_assert (lref->type == rref->type); switch (lref->type) diff -Nrcpad gcc-4.3.3/gcc/fortran/dependency.h gcc-4.4.0/gcc/fortran/dependency.h *** gcc-4.3.3/gcc/fortran/dependency.h Mon Nov 24 12:13:59 2008 --- gcc-4.4.0/gcc/fortran/dependency.h Sun Nov 16 22:45:10 2008 *************** *** 1,5 **** /* Header for dependency analysis ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook --- 1,5 ---- /* Header for dependency analysis ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Paul Brook diff -Nrcpad gcc-4.3.3/gcc/fortran/dump-parse-tree.c gcc-4.4.0/gcc/fortran/dump-parse-tree.c *** gcc-4.3.3/gcc/fortran/dump-parse-tree.c Sun Dec 16 11:34:08 2007 --- gcc-4.4.0/gcc/fortran/dump-parse-tree.c Tue Sep 2 08:13:21 2008 *************** *** 1,5 **** /* Parse tree dumper ! Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Steven Bosscher --- 1,5 ---- /* Parse tree dumper ! Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Steven Bosscher *************** along with GCC; see the file COPYING3. *** 37,42 **** --- 37,52 ---- /* Keep track of indentation for symbol tree dumps. */ static int show_level = 0; + /* The file handle we're dumping to is kept in a static variable. This + is not too cool, but it avoids a lot of passing it around. */ + static FILE *dumpfile; + + /* Forward declaration of some of the functions. */ + static void show_expr (gfc_expr *p); + static void show_code_node (int, gfc_code *); + static void show_namespace (gfc_namespace *ns); + + /* Do indentation for a specific level. */ static inline void *************** code_indent (int level, gfc_st_label *la *** 45,56 **** int i; if (label != NULL) ! gfc_status ("%-5d ", label->value); else ! gfc_status (" "); for (i = 0; i < 2 * level; i++) ! gfc_status_char (' '); } --- 55,66 ---- int i; if (label != NULL) ! fprintf (dumpfile, "%-5d ", label->value); else ! fputs (" ", dumpfile); for (i = 0; i < 2 * level; i++) ! fputc (' ', dumpfile); } *************** code_indent (int level, gfc_st_label *la *** 60,137 **** static inline void show_indent (void) { ! gfc_status ("\n"); code_indent (show_level, NULL); } /* Show type-specific information. */ ! void ! gfc_show_typespec (gfc_typespec *ts) { ! gfc_status ("(%s ", gfc_basic_typename (ts->type)); switch (ts->type) { case BT_DERIVED: ! gfc_status ("%s", ts->derived->name); break; case BT_CHARACTER: ! gfc_show_expr (ts->cl->length); break; default: ! gfc_status ("%d", ts->kind); break; } ! gfc_status (")"); } /* Show an actual argument list. */ ! void ! gfc_show_actual_arglist (gfc_actual_arglist *a) { ! gfc_status ("("); for (; a; a = a->next) { ! gfc_status_char ('('); if (a->name != NULL) ! gfc_status ("%s = ", a->name); if (a->expr != NULL) ! gfc_show_expr (a->expr); else ! gfc_status ("(arg not-present)"); ! gfc_status_char (')'); if (a->next != NULL) ! gfc_status (" "); } ! gfc_status (")"); } /* Show a gfc_array_spec array specification structure. */ ! void ! gfc_show_array_spec (gfc_array_spec *as) { const char *c; int i; if (as == NULL) { ! gfc_status ("()"); return; } ! gfc_status ("(%d", as->rank); if (as->rank != 0) { --- 70,147 ---- static inline void show_indent (void) { ! fputc ('\n', dumpfile); code_indent (show_level, NULL); } /* Show type-specific information. */ ! static void ! show_typespec (gfc_typespec *ts) { ! fprintf (dumpfile, "(%s ", gfc_basic_typename (ts->type)); switch (ts->type) { case BT_DERIVED: ! fprintf (dumpfile, "%s", ts->derived->name); break; case BT_CHARACTER: ! show_expr (ts->cl->length); break; default: ! fprintf (dumpfile, "%d", ts->kind); break; } ! fputc (')', dumpfile); } /* Show an actual argument list. */ ! static void ! show_actual_arglist (gfc_actual_arglist *a) { ! fputc ('(', dumpfile); for (; a; a = a->next) { ! fputc ('(', dumpfile); if (a->name != NULL) ! fprintf (dumpfile, "%s = ", a->name); if (a->expr != NULL) ! show_expr (a->expr); else ! fputs ("(arg not-present)", dumpfile); ! fputc (')', dumpfile); if (a->next != NULL) ! fputc (' ', dumpfile); } ! fputc (')', dumpfile); } /* Show a gfc_array_spec array specification structure. */ ! static void ! show_array_spec (gfc_array_spec *as) { const char *c; int i; if (as == NULL) { ! fputs ("()", dumpfile); return; } ! fprintf (dumpfile, "(%d", as->rank); if (as->rank != 0) { *************** gfc_show_array_spec (gfc_array_spec *as) *** 142,178 **** case AS_ASSUMED_SIZE: c = "AS_ASSUMED_SIZE"; break; case AS_ASSUMED_SHAPE: c = "AS_ASSUMED_SHAPE"; break; default: ! gfc_internal_error ("gfc_show_array_spec(): Unhandled array shape " "type."); } ! gfc_status (" %s ", c); for (i = 0; i < as->rank; i++) { ! gfc_show_expr (as->lower[i]); ! gfc_status_char (' '); ! gfc_show_expr (as->upper[i]); ! gfc_status_char (' '); } } ! gfc_status (")"); } /* Show a gfc_array_ref array reference structure. */ ! void ! gfc_show_array_ref (gfc_array_ref * ar) { int i; ! gfc_status_char ('('); switch (ar->type) { case AR_FULL: ! gfc_status ("FULL"); break; case AR_SECTION: --- 152,188 ---- case AS_ASSUMED_SIZE: c = "AS_ASSUMED_SIZE"; break; case AS_ASSUMED_SHAPE: c = "AS_ASSUMED_SHAPE"; break; default: ! gfc_internal_error ("show_array_spec(): Unhandled array shape " "type."); } ! fprintf (dumpfile, " %s ", c); for (i = 0; i < as->rank; i++) { ! show_expr (as->lower[i]); ! fputc (' ', dumpfile); ! show_expr (as->upper[i]); ! fputc (' ', dumpfile); } } ! fputc (')', dumpfile); } /* Show a gfc_array_ref array reference structure. */ ! static void ! show_array_ref (gfc_array_ref * ar) { int i; ! fputc ('(', dumpfile); switch (ar->type) { case AR_FULL: ! fputs ("FULL", dumpfile); break; case AR_SECTION: *************** gfc_show_array_ref (gfc_array_ref * ar) *** 186,328 **** bound and the stride, if they're present. */ if (ar->start[i] != NULL) ! gfc_show_expr (ar->start[i]); if (ar->dimen_type[i] == DIMEN_RANGE) { ! gfc_status_char (':'); if (ar->end[i] != NULL) ! gfc_show_expr (ar->end[i]); if (ar->stride[i] != NULL) { ! gfc_status_char (':'); ! gfc_show_expr (ar->stride[i]); } } if (i != ar->dimen - 1) ! gfc_status (" , "); } break; case AR_ELEMENT: for (i = 0; i < ar->dimen; i++) { ! gfc_show_expr (ar->start[i]); if (i != ar->dimen - 1) ! gfc_status (" , "); } break; case AR_UNKNOWN: ! gfc_status ("UNKNOWN"); break; default: ! gfc_internal_error ("gfc_show_array_ref(): Unknown array reference"); } ! gfc_status_char (')'); } /* Show a list of gfc_ref structures. */ ! void ! gfc_show_ref (gfc_ref *p) { for (; p; p = p->next) switch (p->type) { case REF_ARRAY: ! gfc_show_array_ref (&p->u.ar); break; case REF_COMPONENT: ! gfc_status (" %% %s", p->u.c.component->name); break; case REF_SUBSTRING: ! gfc_status_char ('('); ! gfc_show_expr (p->u.ss.start); ! gfc_status_char (':'); ! gfc_show_expr (p->u.ss.end); ! gfc_status_char (')'); break; default: ! gfc_internal_error ("gfc_show_ref(): Bad component code"); } } /* Display a constructor. Works recursively for array constructors. */ ! void ! gfc_show_constructor (gfc_constructor *c) { for (; c; c = c->next) { if (c->iterator == NULL) ! gfc_show_expr (c->expr); else { ! gfc_status_char ('('); ! gfc_show_expr (c->expr); ! gfc_status_char (' '); ! gfc_show_expr (c->iterator->var); ! gfc_status_char ('='); ! gfc_show_expr (c->iterator->start); ! gfc_status_char (','); ! gfc_show_expr (c->iterator->end); ! gfc_status_char (','); ! gfc_show_expr (c->iterator->step); ! gfc_status_char (')'); } if (c->next != NULL) ! gfc_status (" , "); } } static void ! show_char_const (const char *c, int length) { int i; ! gfc_status_char ('\''); for (i = 0; i < length; i++) { if (c[i] == '\'') ! gfc_status ("''"); ! else if (ISPRINT (c[i])) ! gfc_status_char (c[i]); else ! { ! gfc_status ("' // ACHAR("); ! printf ("%d", c[i]); ! gfc_status (") // '"); ! } } ! gfc_status_char ('\''); } /* Show an expression. */ ! void ! gfc_show_expr (gfc_expr *p) { const char *c; int i; if (p == NULL) { ! gfc_status ("()"); return; } --- 196,348 ---- bound and the stride, if they're present. */ if (ar->start[i] != NULL) ! show_expr (ar->start[i]); if (ar->dimen_type[i] == DIMEN_RANGE) { ! fputc (':', dumpfile); if (ar->end[i] != NULL) ! show_expr (ar->end[i]); if (ar->stride[i] != NULL) { ! fputc (':', dumpfile); ! show_expr (ar->stride[i]); } } if (i != ar->dimen - 1) ! fputs (" , ", dumpfile); } break; case AR_ELEMENT: for (i = 0; i < ar->dimen; i++) { ! show_expr (ar->start[i]); if (i != ar->dimen - 1) ! fputs (" , ", dumpfile); } break; case AR_UNKNOWN: ! fputs ("UNKNOWN", dumpfile); break; default: ! gfc_internal_error ("show_array_ref(): Unknown array reference"); } ! fputc (')', dumpfile); } /* Show a list of gfc_ref structures. */ ! static void ! show_ref (gfc_ref *p) { for (; p; p = p->next) switch (p->type) { case REF_ARRAY: ! show_array_ref (&p->u.ar); break; case REF_COMPONENT: ! fprintf (dumpfile, " %% %s", p->u.c.component->name); break; case REF_SUBSTRING: ! fputc ('(', dumpfile); ! show_expr (p->u.ss.start); ! fputc (':', dumpfile); ! show_expr (p->u.ss.end); ! fputc (')', dumpfile); break; default: ! gfc_internal_error ("show_ref(): Bad component code"); } } /* Display a constructor. Works recursively for array constructors. */ ! static void ! show_constructor (gfc_constructor *c) { for (; c; c = c->next) { if (c->iterator == NULL) ! show_expr (c->expr); else { ! fputc ('(', dumpfile); ! show_expr (c->expr); ! fputc (' ', dumpfile); ! show_expr (c->iterator->var); ! fputc ('=', dumpfile); ! show_expr (c->iterator->start); ! fputc (',', dumpfile); ! show_expr (c->iterator->end); ! fputc (',', dumpfile); ! show_expr (c->iterator->step); ! fputc (')', dumpfile); } if (c->next != NULL) ! fputs (" , ", dumpfile); } } static void ! show_char_const (const gfc_char_t *c, int length) { int i; ! fputc ('\'', dumpfile); for (i = 0; i < length; i++) { if (c[i] == '\'') ! fputs ("''", dumpfile); else ! fputs (gfc_print_wide_char (c[i]), dumpfile); } ! fputc ('\'', dumpfile); ! } ! ! ! /* Show a component-call expression. */ ! ! static void ! show_compcall (gfc_expr* p) ! { ! gcc_assert (p->expr_type == EXPR_COMPCALL); ! ! fprintf (dumpfile, "%s", p->symtree->n.sym->name); ! show_ref (p->ref); ! fprintf (dumpfile, "%s", p->value.compcall.name); ! ! show_actual_arglist (p->value.compcall.actual); } + /* Show an expression. */ ! static void ! show_expr (gfc_expr *p) { const char *c; int i; if (p == NULL) { ! fputs ("()", dumpfile); return; } *************** gfc_show_expr (gfc_expr *p) *** 330,354 **** { case EXPR_SUBSTRING: show_char_const (p->value.character.string, p->value.character.length); ! gfc_show_ref (p->ref); break; case EXPR_STRUCTURE: ! gfc_status ("%s(", p->ts.derived->name); ! gfc_show_constructor (p->value.constructor); ! gfc_status_char (')'); break; case EXPR_ARRAY: ! gfc_status ("(/ "); ! gfc_show_constructor (p->value.constructor); ! gfc_status (" /)"); ! gfc_show_ref (p->ref); break; case EXPR_NULL: ! gfc_status ("NULL()"); break; case EXPR_CONSTANT: --- 350,374 ---- { case EXPR_SUBSTRING: show_char_const (p->value.character.string, p->value.character.length); ! show_ref (p->ref); break; case EXPR_STRUCTURE: ! fprintf (dumpfile, "%s(", p->ts.derived->name); ! show_constructor (p->value.constructor); ! fputc (')', dumpfile); break; case EXPR_ARRAY: ! fputs ("(/ ", dumpfile); ! show_constructor (p->value.constructor); ! fputs (" /)", dumpfile); ! show_ref (p->ref); break; case EXPR_NULL: ! fputs ("NULL()", dumpfile); break; case EXPR_CONSTANT: *************** gfc_show_expr (gfc_expr *p) *** 358,377 **** mpz_out_str (stdout, 10, p->value.integer); if (p->ts.kind != gfc_default_integer_kind) ! gfc_status ("_%d", p->ts.kind); break; case BT_LOGICAL: if (p->value.logical) ! gfc_status (".true."); else ! gfc_status (".false."); break; case BT_REAL: mpfr_out_str (stdout, 10, 0, p->value.real, GFC_RND_MODE); if (p->ts.kind != gfc_default_real_kind) ! gfc_status ("_%d", p->ts.kind); break; case BT_CHARACTER: --- 378,397 ---- mpz_out_str (stdout, 10, p->value.integer); if (p->ts.kind != gfc_default_integer_kind) ! fprintf (dumpfile, "_%d", p->ts.kind); break; case BT_LOGICAL: if (p->value.logical) ! fputs (".true.", dumpfile); else ! fputs (".false.", dumpfile); break; case BT_REAL: mpfr_out_str (stdout, 10, 0, p->value.real, GFC_RND_MODE); if (p->ts.kind != gfc_default_real_kind) ! fprintf (dumpfile, "_%d", p->ts.kind); break; case BT_CHARACTER: *************** gfc_show_expr (gfc_expr *p) *** 380,653 **** break; case BT_COMPLEX: ! gfc_status ("(complex "); mpfr_out_str (stdout, 10, 0, p->value.complex.r, GFC_RND_MODE); if (p->ts.kind != gfc_default_complex_kind) ! gfc_status ("_%d", p->ts.kind); ! gfc_status (" "); mpfr_out_str (stdout, 10, 0, p->value.complex.i, GFC_RND_MODE); if (p->ts.kind != gfc_default_complex_kind) ! gfc_status ("_%d", p->ts.kind); ! gfc_status (")"); break; case BT_HOLLERITH: ! gfc_status ("%dH", p->representation.length); c = p->representation.string; for (i = 0; i < p->representation.length; i++, c++) { ! gfc_status_char (*c); } break; default: ! gfc_status ("???"); break; } if (p->representation.string) { ! gfc_status (" {"); c = p->representation.string; for (i = 0; i < p->representation.length; i++, c++) { ! gfc_status ("%.2x", (unsigned int) *c); if (i < p->representation.length - 1) ! gfc_status_char (','); } ! gfc_status_char ('}'); } break; case EXPR_VARIABLE: if (p->symtree->n.sym->ns && p->symtree->n.sym->ns->proc_name) ! gfc_status ("%s:", p->symtree->n.sym->ns->proc_name->name); ! gfc_status ("%s", p->symtree->n.sym->name); ! gfc_show_ref (p->ref); break; case EXPR_OP: ! gfc_status ("("); ! switch (p->value.op.operator) { case INTRINSIC_UPLUS: ! gfc_status ("U+ "); break; case INTRINSIC_UMINUS: ! gfc_status ("U- "); break; case INTRINSIC_PLUS: ! gfc_status ("+ "); break; case INTRINSIC_MINUS: ! gfc_status ("- "); break; case INTRINSIC_TIMES: ! gfc_status ("* "); break; case INTRINSIC_DIVIDE: ! gfc_status ("/ "); break; case INTRINSIC_POWER: ! gfc_status ("** "); break; case INTRINSIC_CONCAT: ! gfc_status ("// "); break; case INTRINSIC_AND: ! gfc_status ("AND "); break; case INTRINSIC_OR: ! gfc_status ("OR "); break; case INTRINSIC_EQV: ! gfc_status ("EQV "); break; case INTRINSIC_NEQV: ! gfc_status ("NEQV "); break; case INTRINSIC_EQ: case INTRINSIC_EQ_OS: ! gfc_status ("= "); break; case INTRINSIC_NE: case INTRINSIC_NE_OS: ! gfc_status ("/= "); break; case INTRINSIC_GT: case INTRINSIC_GT_OS: ! gfc_status ("> "); break; case INTRINSIC_GE: case INTRINSIC_GE_OS: ! gfc_status (">= "); break; case INTRINSIC_LT: case INTRINSIC_LT_OS: ! gfc_status ("< "); break; case INTRINSIC_LE: case INTRINSIC_LE_OS: ! gfc_status ("<= "); break; case INTRINSIC_NOT: ! gfc_status ("NOT "); break; case INTRINSIC_PARENTHESES: ! gfc_status ("parens"); break; default: gfc_internal_error ! ("gfc_show_expr(): Bad intrinsic in expression!"); } ! gfc_show_expr (p->value.op.op1); if (p->value.op.op2) { ! gfc_status (" "); ! gfc_show_expr (p->value.op.op2); } ! gfc_status (")"); break; case EXPR_FUNCTION: if (p->value.function.name == NULL) { ! gfc_status ("%s[", p->symtree->n.sym->name); ! gfc_show_actual_arglist (p->value.function.actual); ! gfc_status_char (']'); } else { ! gfc_status ("%s[[", p->value.function.name); ! gfc_show_actual_arglist (p->value.function.actual); ! gfc_status_char (']'); ! gfc_status_char (']'); } break; default: ! gfc_internal_error ("gfc_show_expr(): Don't know how to show expr"); } } - /* Show an expression for diagnostic purposes. */ - void - gfc_show_expr_n (const char * msg, gfc_expr *e) - { - if (msg) - gfc_status (msg); - gfc_show_expr (e); - gfc_status_char ('\n'); - } - /* Show symbol attributes. The flavor and intent are followed by whatever single bit attributes are present. */ ! void ! gfc_show_attr (symbol_attribute *attr) { ! gfc_status ("(%s %s %s %s %s", gfc_code2string (flavors, attr->flavor), ! gfc_intent_string (attr->intent), ! gfc_code2string (access_types, attr->access), ! gfc_code2string (procedures, attr->proc), ! gfc_code2string (save_status, attr->save)); if (attr->allocatable) ! gfc_status (" ALLOCATABLE"); if (attr->dimension) ! gfc_status (" DIMENSION"); if (attr->external) ! gfc_status (" EXTERNAL"); if (attr->intrinsic) ! gfc_status (" INTRINSIC"); if (attr->optional) ! gfc_status (" OPTIONAL"); if (attr->pointer) ! gfc_status (" POINTER"); ! if (attr->protected) ! gfc_status (" PROTECTED"); if (attr->value) ! gfc_status (" VALUE"); if (attr->volatile_) ! gfc_status (" VOLATILE"); if (attr->threadprivate) ! gfc_status (" THREADPRIVATE"); if (attr->target) ! gfc_status (" TARGET"); if (attr->dummy) ! gfc_status (" DUMMY"); if (attr->result) ! gfc_status (" RESULT"); if (attr->entry) ! gfc_status (" ENTRY"); if (attr->is_bind_c) ! gfc_status (" BIND(C)"); if (attr->data) ! gfc_status (" DATA"); if (attr->use_assoc) ! gfc_status (" USE-ASSOC"); if (attr->in_namelist) ! gfc_status (" IN-NAMELIST"); if (attr->in_common) ! gfc_status (" IN-COMMON"); if (attr->abstract) ! gfc_status (" ABSTRACT INTERFACE"); if (attr->function) ! gfc_status (" FUNCTION"); if (attr->subroutine) ! gfc_status (" SUBROUTINE"); if (attr->implicit_type) ! gfc_status (" IMPLICIT-TYPE"); if (attr->sequence) ! gfc_status (" SEQUENCE"); if (attr->elemental) ! gfc_status (" ELEMENTAL"); if (attr->pure) ! gfc_status (" PURE"); if (attr->recursive) ! gfc_status (" RECURSIVE"); ! gfc_status (")"); } /* Show components of a derived type. */ ! void ! gfc_show_components (gfc_symbol *sym) { gfc_component *c; for (c = sym->components; c; c = c->next) { ! gfc_status ("(%s ", c->name); ! gfc_show_typespec (&c->ts); ! if (c->pointer) ! gfc_status (" POINTER"); ! if (c->dimension) ! gfc_status (" DIMENSION"); ! gfc_status_char (' '); ! gfc_show_array_spec (c->as); ! if (c->access) ! gfc_status (" %s", gfc_code2string (access_types, c->access)); ! gfc_status (")"); if (c->next != NULL) ! gfc_status_char (' '); } } --- 400,738 ---- break; case BT_COMPLEX: ! fputs ("(complex ", dumpfile); mpfr_out_str (stdout, 10, 0, p->value.complex.r, GFC_RND_MODE); if (p->ts.kind != gfc_default_complex_kind) ! fprintf (dumpfile, "_%d", p->ts.kind); ! fputc (' ', dumpfile); mpfr_out_str (stdout, 10, 0, p->value.complex.i, GFC_RND_MODE); if (p->ts.kind != gfc_default_complex_kind) ! fprintf (dumpfile, "_%d", p->ts.kind); ! fputc (')', dumpfile); break; case BT_HOLLERITH: ! fprintf (dumpfile, "%dH", p->representation.length); c = p->representation.string; for (i = 0; i < p->representation.length; i++, c++) { ! fputc (*c, dumpfile); } break; default: ! fputs ("???", dumpfile); break; } if (p->representation.string) { ! fputs (" {", dumpfile); c = p->representation.string; for (i = 0; i < p->representation.length; i++, c++) { ! fprintf (dumpfile, "%.2x", (unsigned int) *c); if (i < p->representation.length - 1) ! fputc (',', dumpfile); } ! fputc ('}', dumpfile); } break; case EXPR_VARIABLE: if (p->symtree->n.sym->ns && p->symtree->n.sym->ns->proc_name) ! fprintf (dumpfile, "%s:", p->symtree->n.sym->ns->proc_name->name); ! fprintf (dumpfile, "%s", p->symtree->n.sym->name); ! show_ref (p->ref); break; case EXPR_OP: ! fputc ('(', dumpfile); ! switch (p->value.op.op) { case INTRINSIC_UPLUS: ! fputs ("U+ ", dumpfile); break; case INTRINSIC_UMINUS: ! fputs ("U- ", dumpfile); break; case INTRINSIC_PLUS: ! fputs ("+ ", dumpfile); break; case INTRINSIC_MINUS: ! fputs ("- ", dumpfile); break; case INTRINSIC_TIMES: ! fputs ("* ", dumpfile); break; case INTRINSIC_DIVIDE: ! fputs ("/ ", dumpfile); break; case INTRINSIC_POWER: ! fputs ("** ", dumpfile); break; case INTRINSIC_CONCAT: ! fputs ("// ", dumpfile); break; case INTRINSIC_AND: ! fputs ("AND ", dumpfile); break; case INTRINSIC_OR: ! fputs ("OR ", dumpfile); break; case INTRINSIC_EQV: ! fputs ("EQV ", dumpfile); break; case INTRINSIC_NEQV: ! fputs ("NEQV ", dumpfile); break; case INTRINSIC_EQ: case INTRINSIC_EQ_OS: ! fputs ("= ", dumpfile); break; case INTRINSIC_NE: case INTRINSIC_NE_OS: ! fputs ("/= ", dumpfile); break; case INTRINSIC_GT: case INTRINSIC_GT_OS: ! fputs ("> ", dumpfile); break; case INTRINSIC_GE: case INTRINSIC_GE_OS: ! fputs (">= ", dumpfile); break; case INTRINSIC_LT: case INTRINSIC_LT_OS: ! fputs ("< ", dumpfile); break; case INTRINSIC_LE: case INTRINSIC_LE_OS: ! fputs ("<= ", dumpfile); break; case INTRINSIC_NOT: ! fputs ("NOT ", dumpfile); break; case INTRINSIC_PARENTHESES: ! fputs ("parens", dumpfile); break; default: gfc_internal_error ! ("show_expr(): Bad intrinsic in expression!"); } ! show_expr (p->value.op.op1); if (p->value.op.op2) { ! fputc (' ', dumpfile); ! show_expr (p->value.op.op2); } ! fputc (')', dumpfile); break; case EXPR_FUNCTION: if (p->value.function.name == NULL) { ! fprintf (dumpfile, "%s[", p->symtree->n.sym->name); ! show_actual_arglist (p->value.function.actual); ! fputc (']', dumpfile); } else { ! fprintf (dumpfile, "%s[[", p->value.function.name); ! show_actual_arglist (p->value.function.actual); ! fputc (']', dumpfile); ! fputc (']', dumpfile); } break; + case EXPR_COMPCALL: + show_compcall (p); + break; + default: ! gfc_internal_error ("show_expr(): Don't know how to show expr"); } } /* Show symbol attributes. The flavor and intent are followed by whatever single bit attributes are present. */ ! static void ! show_attr (symbol_attribute *attr) { ! fprintf (dumpfile, "(%s %s %s %s %s", ! gfc_code2string (flavors, attr->flavor), ! gfc_intent_string (attr->intent), ! gfc_code2string (access_types, attr->access), ! gfc_code2string (procedures, attr->proc), ! gfc_code2string (save_status, attr->save)); if (attr->allocatable) ! fputs (" ALLOCATABLE", dumpfile); if (attr->dimension) ! fputs (" DIMENSION", dumpfile); if (attr->external) ! fputs (" EXTERNAL", dumpfile); if (attr->intrinsic) ! fputs (" INTRINSIC", dumpfile); if (attr->optional) ! fputs (" OPTIONAL", dumpfile); if (attr->pointer) ! fputs (" POINTER", dumpfile); ! if (attr->is_protected) ! fputs (" PROTECTED", dumpfile); if (attr->value) ! fputs (" VALUE", dumpfile); if (attr->volatile_) ! fputs (" VOLATILE", dumpfile); if (attr->threadprivate) ! fputs (" THREADPRIVATE", dumpfile); if (attr->target) ! fputs (" TARGET", dumpfile); if (attr->dummy) ! fputs (" DUMMY", dumpfile); if (attr->result) ! fputs (" RESULT", dumpfile); if (attr->entry) ! fputs (" ENTRY", dumpfile); if (attr->is_bind_c) ! fputs (" BIND(C)", dumpfile); if (attr->data) ! fputs (" DATA", dumpfile); if (attr->use_assoc) ! fputs (" USE-ASSOC", dumpfile); if (attr->in_namelist) ! fputs (" IN-NAMELIST", dumpfile); if (attr->in_common) ! fputs (" IN-COMMON", dumpfile); if (attr->abstract) ! fputs (" ABSTRACT", dumpfile); if (attr->function) ! fputs (" FUNCTION", dumpfile); if (attr->subroutine) ! fputs (" SUBROUTINE", dumpfile); if (attr->implicit_type) ! fputs (" IMPLICIT-TYPE", dumpfile); if (attr->sequence) ! fputs (" SEQUENCE", dumpfile); if (attr->elemental) ! fputs (" ELEMENTAL", dumpfile); if (attr->pure) ! fputs (" PURE", dumpfile); if (attr->recursive) ! fputs (" RECURSIVE", dumpfile); ! fputc (')', dumpfile); } /* Show components of a derived type. */ ! static void ! show_components (gfc_symbol *sym) { gfc_component *c; for (c = sym->components; c; c = c->next) { ! fprintf (dumpfile, "(%s ", c->name); ! show_typespec (&c->ts); ! if (c->attr.pointer) ! fputs (" POINTER", dumpfile); ! if (c->attr.dimension) ! fputs (" DIMENSION", dumpfile); ! fputc (' ', dumpfile); ! show_array_spec (c->as); ! if (c->attr.access) ! fprintf (dumpfile, " %s", gfc_code2string (access_types, c->attr.access)); ! fputc (')', dumpfile); if (c->next != NULL) ! fputc (' ', dumpfile); ! } ! } ! ! ! /* Show the f2k_derived namespace with procedure bindings. */ ! ! static void ! show_typebound (gfc_symtree* st) ! { ! if (!st->typebound) ! return; ! ! show_indent (); ! ! if (st->typebound->is_generic) ! fputs ("GENERIC", dumpfile); ! else ! { ! fputs ("PROCEDURE, ", dumpfile); ! if (st->typebound->nopass) ! fputs ("NOPASS", dumpfile); ! else ! { ! if (st->typebound->pass_arg) ! fprintf (dumpfile, "PASS(%s)", st->typebound->pass_arg); ! else ! fputs ("PASS", dumpfile); ! } ! if (st->typebound->non_overridable) ! fputs (", NON_OVERRIDABLE", dumpfile); } + + if (st->typebound->access == ACCESS_PUBLIC) + fputs (", PUBLIC", dumpfile); + else + fputs (", PRIVATE", dumpfile); + + fprintf (dumpfile, " :: %s => ", st->n.sym->name); + + if (st->typebound->is_generic) + { + gfc_tbp_generic* g; + for (g = st->typebound->u.generic; g; g = g->next) + { + fputs (g->specific_st->name, dumpfile); + if (g->next) + fputs (", ", dumpfile); + } + } + else + fputs (st->typebound->u.specific->n.sym->name, dumpfile); + } + + static void + show_f2k_derived (gfc_namespace* f2k) + { + gfc_finalizer* f; + + ++show_level; + + /* Finalizer bindings. */ + for (f = f2k->finalizers; f; f = f->next) + { + show_indent (); + fprintf (dumpfile, "FINAL %s", f->proc_sym->name); + } + + /* Type-bound procedures. */ + gfc_traverse_symtree (f2k->sym_root, &show_typebound); + + --show_level; } *************** gfc_show_components (gfc_symbol *sym) *** 656,663 **** specific interfaces associated with a generic symbol is done within that symbol. */ ! void ! gfc_show_symbol (gfc_symbol *sym) { gfc_formal_arglist *formal; gfc_interface *intr; --- 741,748 ---- specific interfaces associated with a generic symbol is done within that symbol. */ ! static void ! show_symbol (gfc_symbol *sym) { gfc_formal_arglist *formal; gfc_interface *intr; *************** gfc_show_symbol (gfc_symbol *sym) *** 667,744 **** show_indent (); ! gfc_status ("symbol %s ", sym->name); ! gfc_show_typespec (&sym->ts); ! gfc_show_attr (&sym->attr); if (sym->value) { show_indent (); ! gfc_status ("value: "); ! gfc_show_expr (sym->value); } if (sym->as) { show_indent (); ! gfc_status ("Array spec:"); ! gfc_show_array_spec (sym->as); } if (sym->generic) { show_indent (); ! gfc_status ("Generic interfaces:"); for (intr = sym->generic; intr; intr = intr->next) ! gfc_status (" %s", intr->sym->name); } if (sym->result) { show_indent (); ! gfc_status ("result: %s", sym->result->name); } if (sym->components) { show_indent (); ! gfc_status ("components: "); ! gfc_show_components (sym); } if (sym->formal) { show_indent (); ! gfc_status ("Formal arglist:"); for (formal = sym->formal; formal; formal = formal->next) { if (formal->sym != NULL) ! gfc_status (" %s", formal->sym->name); else ! gfc_status (" [Alt Return]"); } } if (sym->formal_ns) { show_indent (); ! gfc_status ("Formal namespace"); ! gfc_show_namespace (sym->formal_ns); } ! gfc_status_char ('\n'); ! } ! ! ! /* Show a symbol for diagnostic purposes. */ ! void ! gfc_show_symbol_n (const char * msg, gfc_symbol *sym) ! { ! if (msg) ! gfc_status (msg); ! gfc_show_symbol (sym); ! gfc_status_char ('\n'); } --- 752,825 ---- show_indent (); ! fprintf (dumpfile, "symbol %s ", sym->name); ! show_typespec (&sym->ts); ! show_attr (&sym->attr); if (sym->value) { show_indent (); ! fputs ("value: ", dumpfile); ! show_expr (sym->value); } if (sym->as) { show_indent (); ! fputs ("Array spec:", dumpfile); ! show_array_spec (sym->as); } if (sym->generic) { show_indent (); ! fputs ("Generic interfaces:", dumpfile); for (intr = sym->generic; intr; intr = intr->next) ! fprintf (dumpfile, " %s", intr->sym->name); } if (sym->result) { show_indent (); ! fprintf (dumpfile, "result: %s", sym->result->name); } if (sym->components) { show_indent (); ! fputs ("components: ", dumpfile); ! show_components (sym); ! } ! ! if (sym->f2k_derived) ! { ! show_indent (); ! fputs ("Procedure bindings:\n", dumpfile); ! show_f2k_derived (sym->f2k_derived); } if (sym->formal) { show_indent (); ! fputs ("Formal arglist:", dumpfile); for (formal = sym->formal; formal; formal = formal->next) { if (formal->sym != NULL) ! fprintf (dumpfile, " %s", formal->sym->name); else ! fputs (" [Alt Return]", dumpfile); } } if (sym->formal_ns) { show_indent (); ! fputs ("Formal namespace", dumpfile); ! show_namespace (sym->formal_ns); } ! fputc ('\n', dumpfile); } *************** show_uop (gfc_user_op *uop) *** 751,760 **** gfc_interface *intr; show_indent (); ! gfc_status ("%s:", uop->name); ! for (intr = uop->operator; intr; intr = intr->next) ! gfc_status (" %s", intr->sym->name); } --- 832,841 ---- gfc_interface *intr; show_indent (); ! fprintf (dumpfile, "%s:", uop->name); ! for (intr = uop->op; intr; intr = intr->next) ! fprintf (dumpfile, " %s", intr->sym->name); } *************** show_common (gfc_symtree *st) *** 790,806 **** gfc_symbol *s; show_indent (); ! gfc_status ("common: /%s/ ", st->name); s = st->n.common->head; while (s) { ! gfc_status ("%s", s->name); s = s->common_next; if (s) ! gfc_status (", "); } ! gfc_status_char ('\n'); } --- 871,887 ---- gfc_symbol *s; show_indent (); ! fprintf (dumpfile, "common: /%s/ ", st->name); s = st->n.common->head; while (s) { ! fprintf (dumpfile, "%s", s->name); s = s->common_next; if (s) ! fputs (", ", dumpfile); } ! fputc ('\n', dumpfile); } *************** static void *** 810,853 **** show_symtree (gfc_symtree *st) { show_indent (); ! gfc_status ("symtree: %s Ambig %d", st->name, st->ambiguous); if (st->n.sym->ns != gfc_current_ns) ! gfc_status (" from namespace %s", st->n.sym->ns->proc_name->name); else ! gfc_show_symbol (st->n.sym); } /******************* Show gfc_code structures **************/ - - static void gfc_show_code_node (int, gfc_code *); - /* Show a list of code structures. Mutually recursive with ! gfc_show_code_node(). */ ! void ! gfc_show_code (int level, gfc_code *c) { for (; c; c = c->next) ! gfc_show_code_node (level, c); } ! void ! gfc_show_namelist (gfc_namelist *n) { for (; n->next; n = n->next) ! gfc_status ("%s,", n->sym->name); ! gfc_status ("%s", n->sym->name); } /* Show a single OpenMP directive node and everything underneath it if necessary. */ static void ! gfc_show_omp_node (int level, gfc_code *c) { gfc_omp_clauses *omp_clauses = NULL; const char *name = NULL; --- 891,931 ---- show_symtree (gfc_symtree *st) { show_indent (); ! fprintf (dumpfile, "symtree: %s Ambig %d", st->name, st->ambiguous); if (st->n.sym->ns != gfc_current_ns) ! fprintf (dumpfile, " from namespace %s", st->n.sym->ns->proc_name->name); else ! show_symbol (st->n.sym); } /******************* Show gfc_code structures **************/ /* Show a list of code structures. Mutually recursive with ! show_code_node(). */ ! static void ! show_code (int level, gfc_code *c) { for (; c; c = c->next) ! show_code_node (level, c); } ! static void ! show_namelist (gfc_namelist *n) { for (; n->next; n = n->next) ! fprintf (dumpfile, "%s,", n->sym->name); ! fprintf (dumpfile, "%s", n->sym->name); } /* Show a single OpenMP directive node and everything underneath it if necessary. */ static void ! show_omp_node (int level, gfc_code *c) { gfc_omp_clauses *omp_clauses = NULL; const char *name = NULL; *************** gfc_show_omp_node (int level, gfc_code * *** 867,877 **** case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break; case EXEC_OMP_SECTIONS: name = "SECTIONS"; break; case EXEC_OMP_SINGLE: name = "SINGLE"; break; case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break; default: gcc_unreachable (); } ! gfc_status ("!$OMP %s", name); switch (c->op) { case EXEC_OMP_DO: --- 945,957 ---- case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break; case EXEC_OMP_SECTIONS: name = "SECTIONS"; break; case EXEC_OMP_SINGLE: name = "SINGLE"; break; + case EXEC_OMP_TASK: name = "TASK"; break; + case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break; case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break; default: gcc_unreachable (); } ! fprintf (dumpfile, "!$OMP %s", name); switch (c->op) { case EXEC_OMP_DO: *************** gfc_show_omp_node (int level, gfc_code * *** 882,902 **** case EXEC_OMP_SINGLE: case EXEC_OMP_WORKSHARE: case EXEC_OMP_PARALLEL_WORKSHARE: omp_clauses = c->ext.omp_clauses; break; case EXEC_OMP_CRITICAL: if (c->ext.omp_name) ! gfc_status (" (%s)", c->ext.omp_name); break; case EXEC_OMP_FLUSH: if (c->ext.omp_namelist) { ! gfc_status (" ("); ! gfc_show_namelist (c->ext.omp_namelist); ! gfc_status_char (')'); } return; case EXEC_OMP_BARRIER: return; default: break; --- 962,984 ---- case EXEC_OMP_SINGLE: case EXEC_OMP_WORKSHARE: case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_TASK: omp_clauses = c->ext.omp_clauses; break; case EXEC_OMP_CRITICAL: if (c->ext.omp_name) ! fprintf (dumpfile, " (%s)", c->ext.omp_name); break; case EXEC_OMP_FLUSH: if (c->ext.omp_namelist) { ! fputs (" (", dumpfile); ! show_namelist (c->ext.omp_namelist); ! fputc (')', dumpfile); } return; case EXEC_OMP_BARRIER: + case EXEC_OMP_TASKWAIT: return; default: break; *************** gfc_show_omp_node (int level, gfc_code * *** 907,921 **** if (omp_clauses->if_expr) { ! gfc_status (" IF("); ! gfc_show_expr (omp_clauses->if_expr); ! gfc_status_char (')'); } if (omp_clauses->num_threads) { ! gfc_status (" NUM_THREADS("); ! gfc_show_expr (omp_clauses->num_threads); ! gfc_status_char (')'); } if (omp_clauses->sched_kind != OMP_SCHED_NONE) { --- 989,1003 ---- if (omp_clauses->if_expr) { ! fputs (" IF(", dumpfile); ! show_expr (omp_clauses->if_expr); ! fputc (')', dumpfile); } if (omp_clauses->num_threads) { ! fputs (" NUM_THREADS(", dumpfile); ! show_expr (omp_clauses->num_threads); ! fputc (')', dumpfile); } if (omp_clauses->sched_kind != OMP_SCHED_NONE) { *************** gfc_show_omp_node (int level, gfc_code * *** 926,941 **** case OMP_SCHED_DYNAMIC: type = "DYNAMIC"; break; case OMP_SCHED_GUIDED: type = "GUIDED"; break; case OMP_SCHED_RUNTIME: type = "RUNTIME"; break; default: gcc_unreachable (); } ! gfc_status (" SCHEDULE (%s", type); if (omp_clauses->chunk_size) { ! gfc_status_char (','); ! gfc_show_expr (omp_clauses->chunk_size); } ! gfc_status_char (')'); } if (omp_clauses->default_sharing != OMP_DEFAULT_UNKNOWN) { --- 1008,1024 ---- case OMP_SCHED_DYNAMIC: type = "DYNAMIC"; break; case OMP_SCHED_GUIDED: type = "GUIDED"; break; case OMP_SCHED_RUNTIME: type = "RUNTIME"; break; + case OMP_SCHED_AUTO: type = "AUTO"; break; default: gcc_unreachable (); } ! fprintf (dumpfile, " SCHEDULE (%s", type); if (omp_clauses->chunk_size) { ! fputc (',', dumpfile); ! show_expr (omp_clauses->chunk_size); } ! fputc (')', dumpfile); } if (omp_clauses->default_sharing != OMP_DEFAULT_UNKNOWN) { *************** gfc_show_omp_node (int level, gfc_code * *** 945,958 **** case OMP_DEFAULT_NONE: type = "NONE"; break; case OMP_DEFAULT_PRIVATE: type = "PRIVATE"; break; case OMP_DEFAULT_SHARED: type = "SHARED"; break; ! case OMP_SCHED_RUNTIME: type = "RUNTIME"; break; default: gcc_unreachable (); } ! gfc_status (" DEFAULT(%s)", type); } if (omp_clauses->ordered) ! gfc_status (" ORDERED"); for (list_type = 0; list_type < OMP_LIST_NUM; list_type++) if (omp_clauses->lists[list_type] != NULL && list_type != OMP_LIST_COPYPRIVATE) --- 1028,1045 ---- case OMP_DEFAULT_NONE: type = "NONE"; break; case OMP_DEFAULT_PRIVATE: type = "PRIVATE"; break; case OMP_DEFAULT_SHARED: type = "SHARED"; break; ! case OMP_DEFAULT_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break; default: gcc_unreachable (); } ! fprintf (dumpfile, " DEFAULT(%s)", type); } if (omp_clauses->ordered) ! fputs (" ORDERED", dumpfile); ! if (omp_clauses->untied) ! fputs (" UNTIED", dumpfile); ! if (omp_clauses->collapse) ! fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse); for (list_type = 0; list_type < OMP_LIST_NUM; list_type++) if (omp_clauses->lists[list_type] != NULL && list_type != OMP_LIST_COPYPRIVATE) *************** gfc_show_omp_node (int level, gfc_code * *** 977,983 **** default: gcc_unreachable (); } ! gfc_status (" REDUCTION(%s:", type); } else { --- 1064,1070 ---- default: gcc_unreachable (); } ! fprintf (dumpfile, " REDUCTION(%s:", type); } else { *************** gfc_show_omp_node (int level, gfc_code * *** 991,1042 **** default: gcc_unreachable (); } ! gfc_status (" %s(", type); } ! gfc_show_namelist (omp_clauses->lists[list_type]); ! gfc_status_char (')'); } } ! gfc_status_char ('\n'); if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS) { gfc_code *d = c->block; while (d != NULL) { ! gfc_show_code (level + 1, d->next); if (d->block == NULL) break; code_indent (level, 0); ! gfc_status ("!$OMP SECTION\n"); d = d->block; } } else ! gfc_show_code (level + 1, c->block->next); if (c->op == EXEC_OMP_ATOMIC) return; code_indent (level, 0); ! gfc_status ("!$OMP END %s", name); if (omp_clauses != NULL) { if (omp_clauses->lists[OMP_LIST_COPYPRIVATE]) { ! gfc_status (" COPYPRIVATE("); ! gfc_show_namelist (omp_clauses->lists[OMP_LIST_COPYPRIVATE]); ! gfc_status_char (')'); } else if (omp_clauses->nowait) ! gfc_status (" NOWAIT"); } else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_name) ! gfc_status (" (%s)", c->ext.omp_name); } /* Show a single code node and everything underneath it if necessary. */ static void ! gfc_show_code_node (int level, gfc_code *c) { gfc_forall_iterator *fa; gfc_open *open; --- 1078,1129 ---- default: gcc_unreachable (); } ! fprintf (dumpfile, " %s(", type); } ! show_namelist (omp_clauses->lists[list_type]); ! fputc (')', dumpfile); } } ! fputc ('\n', dumpfile); if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS) { gfc_code *d = c->block; while (d != NULL) { ! show_code (level + 1, d->next); if (d->block == NULL) break; code_indent (level, 0); ! fputs ("!$OMP SECTION\n", dumpfile); d = d->block; } } else ! show_code (level + 1, c->block->next); if (c->op == EXEC_OMP_ATOMIC) return; code_indent (level, 0); ! fprintf (dumpfile, "!$OMP END %s", name); if (omp_clauses != NULL) { if (omp_clauses->lists[OMP_LIST_COPYPRIVATE]) { ! fputs (" COPYPRIVATE(", dumpfile); ! show_namelist (omp_clauses->lists[OMP_LIST_COPYPRIVATE]); ! fputc (')', dumpfile); } 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); } /* Show a single code node and everything underneath it if necessary. */ static void ! show_code_node (int level, gfc_code *c) { gfc_forall_iterator *fa; gfc_open *open; *************** gfc_show_code_node (int level, gfc_code *** 1053,1108 **** switch (c->op) { case EXEC_NOP: ! gfc_status ("NOP"); break; case EXEC_CONTINUE: ! gfc_status ("CONTINUE"); break; case EXEC_ENTRY: ! gfc_status ("ENTRY %s", c->ext.entry->sym->name); break; case EXEC_INIT_ASSIGN: case EXEC_ASSIGN: ! gfc_status ("ASSIGN "); ! gfc_show_expr (c->expr); ! gfc_status_char (' '); ! gfc_show_expr (c->expr2); break; case EXEC_LABEL_ASSIGN: ! gfc_status ("LABEL ASSIGN "); ! gfc_show_expr (c->expr); ! gfc_status (" %d", c->label->value); break; case EXEC_POINTER_ASSIGN: ! gfc_status ("POINTER ASSIGN "); ! gfc_show_expr (c->expr); ! gfc_status_char (' '); ! gfc_show_expr (c->expr2); break; case EXEC_GOTO: ! gfc_status ("GOTO "); if (c->label) ! gfc_status ("%d", c->label->value); else { ! gfc_show_expr (c->expr); d = c->block; if (d != NULL) { ! gfc_status (", ("); for (; d; d = d ->block) { code_indent (level, d->label); if (d->block != NULL) ! gfc_status_char (','); else ! gfc_status_char (')'); } } } --- 1140,1195 ---- switch (c->op) { case EXEC_NOP: ! fputs ("NOP", dumpfile); break; case EXEC_CONTINUE: ! fputs ("CONTINUE", dumpfile); break; case EXEC_ENTRY: ! fprintf (dumpfile, "ENTRY %s", c->ext.entry->sym->name); break; case EXEC_INIT_ASSIGN: case EXEC_ASSIGN: ! fputs ("ASSIGN ", dumpfile); ! show_expr (c->expr); ! fputc (' ', dumpfile); ! show_expr (c->expr2); break; case EXEC_LABEL_ASSIGN: ! fputs ("LABEL ASSIGN ", dumpfile); ! show_expr (c->expr); ! fprintf (dumpfile, " %d", c->label->value); break; case EXEC_POINTER_ASSIGN: ! fputs ("POINTER ASSIGN ", dumpfile); ! show_expr (c->expr); ! fputc (' ', dumpfile); ! show_expr (c->expr2); break; case EXEC_GOTO: ! fputs ("GOTO ", dumpfile); if (c->label) ! fprintf (dumpfile, "%d", c->label->value); else { ! show_expr (c->expr); d = c->block; if (d != NULL) { ! fputs (", (", dumpfile); for (; d; d = d ->block) { code_indent (level, d->label); if (d->block != NULL) ! fputc (',', dumpfile); else ! fputc (')', dumpfile); } } } *************** gfc_show_code_node (int level, gfc_code *** 1111,1164 **** case EXEC_CALL: case EXEC_ASSIGN_CALL: if (c->resolved_sym) ! gfc_status ("CALL %s ", c->resolved_sym->name); else if (c->symtree) ! gfc_status ("CALL %s ", c->symtree->name); else ! gfc_status ("CALL ?? "); ! gfc_show_actual_arglist (c->ext.actual); break; case EXEC_RETURN: ! gfc_status ("RETURN "); if (c->expr) ! gfc_show_expr (c->expr); break; case EXEC_PAUSE: ! gfc_status ("PAUSE "); if (c->expr != NULL) ! gfc_show_expr (c->expr); else ! gfc_status ("%d", c->ext.stop_code); break; case EXEC_STOP: ! gfc_status ("STOP "); if (c->expr != NULL) ! gfc_show_expr (c->expr); else ! gfc_status ("%d", c->ext.stop_code); break; case EXEC_ARITHMETIC_IF: ! gfc_status ("IF "); ! gfc_show_expr (c->expr); ! gfc_status (" %d, %d, %d", c->label->value, c->label2->value, c->label3->value); break; case EXEC_IF: d = c->block; ! gfc_status ("IF "); ! gfc_show_expr (d->expr); ! gfc_status_char ('\n'); ! gfc_show_code (level + 1, d->next); d = d->block; for (; d; d = d->block) --- 1198,1256 ---- case EXEC_CALL: case EXEC_ASSIGN_CALL: if (c->resolved_sym) ! fprintf (dumpfile, "CALL %s ", c->resolved_sym->name); else if (c->symtree) ! fprintf (dumpfile, "CALL %s ", c->symtree->name); else ! fputs ("CALL ?? ", dumpfile); ! show_actual_arglist (c->ext.actual); ! break; ! ! case EXEC_COMPCALL: ! fputs ("CALL ", dumpfile); ! show_compcall (c->expr); break; case EXEC_RETURN: ! fputs ("RETURN ", dumpfile); if (c->expr) ! show_expr (c->expr); break; case EXEC_PAUSE: ! fputs ("PAUSE ", dumpfile); if (c->expr != NULL) ! show_expr (c->expr); else ! fprintf (dumpfile, "%d", c->ext.stop_code); break; case EXEC_STOP: ! fputs ("STOP ", dumpfile); if (c->expr != NULL) ! show_expr (c->expr); else ! fprintf (dumpfile, "%d", c->ext.stop_code); break; case EXEC_ARITHMETIC_IF: ! fputs ("IF ", dumpfile); ! show_expr (c->expr); ! fprintf (dumpfile, " %d, %d, %d", c->label->value, c->label2->value, c->label3->value); break; case EXEC_IF: d = c->block; ! fputs ("IF ", dumpfile); ! show_expr (d->expr); ! fputc ('\n', dumpfile); ! show_code (level + 1, d->next); d = d->block; for (; d; d = d->block) *************** gfc_show_code_node (int level, gfc_code *** 1166,1705 **** code_indent (level, 0); if (d->expr == NULL) ! gfc_status ("ELSE\n"); else { ! gfc_status ("ELSE IF "); ! gfc_show_expr (d->expr); ! gfc_status_char ('\n'); } ! gfc_show_code (level + 1, d->next); } code_indent (level, c->label); ! gfc_status ("ENDIF"); break; case EXEC_SELECT: d = c->block; ! gfc_status ("SELECT CASE "); ! gfc_show_expr (c->expr); ! gfc_status_char ('\n'); for (; d; d = d->block) { code_indent (level, 0); ! gfc_status ("CASE "); for (cp = d->ext.case_list; cp; cp = cp->next) { ! gfc_status_char ('('); ! gfc_show_expr (cp->low); ! gfc_status_char (' '); ! gfc_show_expr (cp->high); ! gfc_status_char (')'); ! gfc_status_char (' '); } ! gfc_status_char ('\n'); ! gfc_show_code (level + 1, d->next); } code_indent (level, c->label); ! gfc_status ("END SELECT"); break; case EXEC_WHERE: ! gfc_status ("WHERE "); d = c->block; ! gfc_show_expr (d->expr); ! gfc_status_char ('\n'); ! gfc_show_code (level + 1, d->next); for (d = d->block; d; d = d->block) { code_indent (level, 0); ! gfc_status ("ELSE WHERE "); ! gfc_show_expr (d->expr); ! gfc_status_char ('\n'); ! gfc_show_code (level + 1, d->next); } code_indent (level, 0); ! gfc_status ("END WHERE"); break; case EXEC_FORALL: ! gfc_status ("FORALL "); for (fa = c->ext.forall_iterator; fa; fa = fa->next) { ! gfc_show_expr (fa->var); ! gfc_status_char (' '); ! gfc_show_expr (fa->start); ! gfc_status_char (':'); ! gfc_show_expr (fa->end); ! gfc_status_char (':'); ! gfc_show_expr (fa->stride); if (fa->next != NULL) ! gfc_status_char (','); } if (c->expr != NULL) { ! gfc_status_char (','); ! gfc_show_expr (c->expr); } ! gfc_status_char ('\n'); ! gfc_show_code (level + 1, c->block->next); code_indent (level, 0); ! gfc_status ("END FORALL"); break; case EXEC_DO: ! gfc_status ("DO "); ! gfc_show_expr (c->ext.iterator->var); ! gfc_status_char ('='); ! gfc_show_expr (c->ext.iterator->start); ! gfc_status_char (' '); ! gfc_show_expr (c->ext.iterator->end); ! gfc_status_char (' '); ! gfc_show_expr (c->ext.iterator->step); ! gfc_status_char ('\n'); ! gfc_show_code (level + 1, c->block->next); code_indent (level, 0); ! gfc_status ("END DO"); break; case EXEC_DO_WHILE: ! gfc_status ("DO WHILE "); ! gfc_show_expr (c->expr); ! gfc_status_char ('\n'); ! gfc_show_code (level + 1, c->block->next); code_indent (level, c->label); ! gfc_status ("END DO"); break; case EXEC_CYCLE: ! gfc_status ("CYCLE"); if (c->symtree) ! gfc_status (" %s", c->symtree->n.sym->name); break; case EXEC_EXIT: ! gfc_status ("EXIT"); if (c->symtree) ! gfc_status (" %s", c->symtree->n.sym->name); break; case EXEC_ALLOCATE: ! gfc_status ("ALLOCATE "); if (c->expr) { ! gfc_status (" STAT="); ! gfc_show_expr (c->expr); } for (a = c->ext.alloc_list; a; a = a->next) { ! gfc_status_char (' '); ! gfc_show_expr (a->expr); } break; case EXEC_DEALLOCATE: ! gfc_status ("DEALLOCATE "); if (c->expr) { ! gfc_status (" STAT="); ! gfc_show_expr (c->expr); } for (a = c->ext.alloc_list; a; a = a->next) { ! gfc_status_char (' '); ! gfc_show_expr (a->expr); } break; case EXEC_OPEN: ! gfc_status ("OPEN"); open = c->ext.open; if (open->unit) { ! gfc_status (" UNIT="); ! gfc_show_expr (open->unit); } if (open->iomsg) { ! gfc_status (" IOMSG="); ! gfc_show_expr (open->iomsg); } if (open->iostat) { ! gfc_status (" IOSTAT="); ! gfc_show_expr (open->iostat); } if (open->file) { ! gfc_status (" FILE="); ! gfc_show_expr (open->file); } if (open->status) { ! gfc_status (" STATUS="); ! gfc_show_expr (open->status); } if (open->access) { ! gfc_status (" ACCESS="); ! gfc_show_expr (open->access); } if (open->form) { ! gfc_status (" FORM="); ! gfc_show_expr (open->form); } if (open->recl) { ! gfc_status (" RECL="); ! gfc_show_expr (open->recl); } if (open->blank) { ! gfc_status (" BLANK="); ! gfc_show_expr (open->blank); } if (open->position) { ! gfc_status (" POSITION="); ! gfc_show_expr (open->position); } if (open->action) { ! gfc_status (" ACTION="); ! gfc_show_expr (open->action); } if (open->delim) { ! gfc_status (" DELIM="); ! gfc_show_expr (open->delim); } if (open->pad) { ! gfc_status (" PAD="); ! gfc_show_expr (open->pad); } if (open->convert) { ! gfc_status (" CONVERT="); ! gfc_show_expr (open->convert); } if (open->err != NULL) ! gfc_status (" ERR=%d", open->err->value); break; case EXEC_CLOSE: ! gfc_status ("CLOSE"); close = c->ext.close; if (close->unit) { ! gfc_status (" UNIT="); ! gfc_show_expr (close->unit); } if (close->iomsg) { ! gfc_status (" IOMSG="); ! gfc_show_expr (close->iomsg); } if (close->iostat) { ! gfc_status (" IOSTAT="); ! gfc_show_expr (close->iostat); } if (close->status) { ! gfc_status (" STATUS="); ! gfc_show_expr (close->status); } if (close->err != NULL) ! gfc_status (" ERR=%d", close->err->value); break; case EXEC_BACKSPACE: ! gfc_status ("BACKSPACE"); goto show_filepos; case EXEC_ENDFILE: ! gfc_status ("ENDFILE"); goto show_filepos; case EXEC_REWIND: ! gfc_status ("REWIND"); goto show_filepos; case EXEC_FLUSH: ! gfc_status ("FLUSH"); show_filepos: fp = c->ext.filepos; if (fp->unit) { ! gfc_status (" UNIT="); ! gfc_show_expr (fp->unit); } if (fp->iomsg) { ! gfc_status (" IOMSG="); ! gfc_show_expr (fp->iomsg); } if (fp->iostat) { ! gfc_status (" IOSTAT="); ! gfc_show_expr (fp->iostat); } if (fp->err != NULL) ! gfc_status (" ERR=%d", fp->err->value); break; case EXEC_INQUIRE: ! gfc_status ("INQUIRE"); i = c->ext.inquire; if (i->unit) { ! gfc_status (" UNIT="); ! gfc_show_expr (i->unit); } if (i->file) { ! gfc_status (" FILE="); ! gfc_show_expr (i->file); } if (i->iomsg) { ! gfc_status (" IOMSG="); ! gfc_show_expr (i->iomsg); } if (i->iostat) { ! gfc_status (" IOSTAT="); ! gfc_show_expr (i->iostat); } if (i->exist) { ! gfc_status (" EXIST="); ! gfc_show_expr (i->exist); } if (i->opened) { ! gfc_status (" OPENED="); ! gfc_show_expr (i->opened); } if (i->number) { ! gfc_status (" NUMBER="); ! gfc_show_expr (i->number); } if (i->named) { ! gfc_status (" NAMED="); ! gfc_show_expr (i->named); } if (i->name) { ! gfc_status (" NAME="); ! gfc_show_expr (i->name); } if (i->access) { ! gfc_status (" ACCESS="); ! gfc_show_expr (i->access); } if (i->sequential) { ! gfc_status (" SEQUENTIAL="); ! gfc_show_expr (i->sequential); } if (i->direct) { ! gfc_status (" DIRECT="); ! gfc_show_expr (i->direct); } if (i->form) { ! gfc_status (" FORM="); ! gfc_show_expr (i->form); } if (i->formatted) { ! gfc_status (" FORMATTED"); ! gfc_show_expr (i->formatted); } if (i->unformatted) { ! gfc_status (" UNFORMATTED="); ! gfc_show_expr (i->unformatted); } if (i->recl) { ! gfc_status (" RECL="); ! gfc_show_expr (i->recl); } if (i->nextrec) { ! gfc_status (" NEXTREC="); ! gfc_show_expr (i->nextrec); } if (i->blank) { ! gfc_status (" BLANK="); ! gfc_show_expr (i->blank); } if (i->position) { ! gfc_status (" POSITION="); ! gfc_show_expr (i->position); } if (i->action) { ! gfc_status (" ACTION="); ! gfc_show_expr (i->action); } if (i->read) { ! gfc_status (" READ="); ! gfc_show_expr (i->read); } if (i->write) { ! gfc_status (" WRITE="); ! gfc_show_expr (i->write); } if (i->readwrite) { ! gfc_status (" READWRITE="); ! gfc_show_expr (i->readwrite); } if (i->delim) { ! gfc_status (" DELIM="); ! gfc_show_expr (i->delim); } if (i->pad) { ! gfc_status (" PAD="); ! gfc_show_expr (i->pad); } if (i->convert) { ! gfc_status (" CONVERT="); ! gfc_show_expr (i->convert); } if (i->err != NULL) ! gfc_status (" ERR=%d", i->err->value); break; case EXEC_IOLENGTH: ! gfc_status ("IOLENGTH "); ! gfc_show_expr (c->expr); goto show_dt_code; break; case EXEC_READ: ! gfc_status ("READ"); goto show_dt; case EXEC_WRITE: ! gfc_status ("WRITE"); show_dt: dt = c->ext.dt; if (dt->io_unit) { ! gfc_status (" UNIT="); ! gfc_show_expr (dt->io_unit); } if (dt->format_expr) { ! gfc_status (" FMT="); ! gfc_show_expr (dt->format_expr); } if (dt->format_label != NULL) ! gfc_status (" FMT=%d", dt->format_label->value); if (dt->namelist) ! gfc_status (" NML=%s", dt->namelist->name); if (dt->iomsg) { ! gfc_status (" IOMSG="); ! gfc_show_expr (dt->iomsg); } if (dt->iostat) { ! gfc_status (" IOSTAT="); ! gfc_show_expr (dt->iostat); } if (dt->size) { ! gfc_status (" SIZE="); ! gfc_show_expr (dt->size); } if (dt->rec) { ! gfc_status (" REC="); ! gfc_show_expr (dt->rec); } if (dt->advance) { ! gfc_status (" ADVANCE="); ! gfc_show_expr (dt->advance); } show_dt_code: ! gfc_status_char ('\n'); for (c = c->block->next; c; c = c->next) ! gfc_show_code_node (level + (c->next != NULL), c); return; case EXEC_TRANSFER: ! gfc_status ("TRANSFER "); ! gfc_show_expr (c->expr); break; case EXEC_DT_END: ! gfc_status ("DT_END"); dt = c->ext.dt; if (dt->err != NULL) ! gfc_status (" ERR=%d", dt->err->value); if (dt->end != NULL) ! gfc_status (" END=%d", dt->end->value); if (dt->eor != NULL) ! gfc_status (" EOR=%d", dt->eor->value); break; case EXEC_OMP_ATOMIC: --- 1258,1907 ---- code_indent (level, 0); if (d->expr == NULL) ! fputs ("ELSE\n", dumpfile); else { ! fputs ("ELSE IF ", dumpfile); ! show_expr (d->expr); ! fputc ('\n', dumpfile); } ! show_code (level + 1, d->next); } code_indent (level, c->label); ! fputs ("ENDIF", dumpfile); break; case EXEC_SELECT: d = c->block; ! fputs ("SELECT CASE ", dumpfile); ! show_expr (c->expr); ! fputc ('\n', dumpfile); for (; d; d = d->block) { code_indent (level, 0); ! fputs ("CASE ", dumpfile); for (cp = d->ext.case_list; cp; cp = cp->next) { ! fputc ('(', dumpfile); ! show_expr (cp->low); ! fputc (' ', dumpfile); ! show_expr (cp->high); ! fputc (')', dumpfile); ! fputc (' ', dumpfile); } ! fputc ('\n', dumpfile); ! show_code (level + 1, d->next); } code_indent (level, c->label); ! fputs ("END SELECT", dumpfile); break; case EXEC_WHERE: ! fputs ("WHERE ", dumpfile); d = c->block; ! show_expr (d->expr); ! fputc ('\n', dumpfile); ! show_code (level + 1, d->next); for (d = d->block; d; d = d->block) { code_indent (level, 0); ! fputs ("ELSE WHERE ", dumpfile); ! show_expr (d->expr); ! fputc ('\n', dumpfile); ! show_code (level + 1, d->next); } code_indent (level, 0); ! fputs ("END WHERE", dumpfile); break; case EXEC_FORALL: ! fputs ("FORALL ", dumpfile); for (fa = c->ext.forall_iterator; fa; fa = fa->next) { ! show_expr (fa->var); ! fputc (' ', dumpfile); ! show_expr (fa->start); ! fputc (':', dumpfile); ! show_expr (fa->end); ! fputc (':', dumpfile); ! show_expr (fa->stride); if (fa->next != NULL) ! fputc (',', dumpfile); } if (c->expr != NULL) { ! fputc (',', dumpfile); ! show_expr (c->expr); } ! fputc ('\n', dumpfile); ! show_code (level + 1, c->block->next); code_indent (level, 0); ! fputs ("END FORALL", dumpfile); break; case EXEC_DO: ! fputs ("DO ", dumpfile); ! show_expr (c->ext.iterator->var); ! fputc ('=', dumpfile); ! show_expr (c->ext.iterator->start); ! fputc (' ', dumpfile); ! show_expr (c->ext.iterator->end); ! fputc (' ', dumpfile); ! show_expr (c->ext.iterator->step); ! fputc ('\n', dumpfile); ! show_code (level + 1, c->block->next); code_indent (level, 0); ! fputs ("END DO", dumpfile); break; case EXEC_DO_WHILE: ! fputs ("DO WHILE ", dumpfile); ! show_expr (c->expr); ! fputc ('\n', dumpfile); ! show_code (level + 1, c->block->next); code_indent (level, c->label); ! fputs ("END DO", dumpfile); break; case EXEC_CYCLE: ! fputs ("CYCLE", dumpfile); if (c->symtree) ! fprintf (dumpfile, " %s", c->symtree->n.sym->name); break; case EXEC_EXIT: ! fputs ("EXIT", dumpfile); if (c->symtree) ! fprintf (dumpfile, " %s", c->symtree->n.sym->name); break; case EXEC_ALLOCATE: ! fputs ("ALLOCATE ", dumpfile); if (c->expr) { ! fputs (" STAT=", dumpfile); ! show_expr (c->expr); } for (a = c->ext.alloc_list; a; a = a->next) { ! fputc (' ', dumpfile); ! show_expr (a->expr); } break; case EXEC_DEALLOCATE: ! fputs ("DEALLOCATE ", dumpfile); if (c->expr) { ! fputs (" STAT=", dumpfile); ! show_expr (c->expr); } for (a = c->ext.alloc_list; a; a = a->next) { ! fputc (' ', dumpfile); ! show_expr (a->expr); } break; case EXEC_OPEN: ! fputs ("OPEN", dumpfile); open = c->ext.open; if (open->unit) { ! fputs (" UNIT=", dumpfile); ! show_expr (open->unit); } if (open->iomsg) { ! fputs (" IOMSG=", dumpfile); ! show_expr (open->iomsg); } if (open->iostat) { ! fputs (" IOSTAT=", dumpfile); ! show_expr (open->iostat); } if (open->file) { ! fputs (" FILE=", dumpfile); ! show_expr (open->file); } if (open->status) { ! fputs (" STATUS=", dumpfile); ! show_expr (open->status); } if (open->access) { ! fputs (" ACCESS=", dumpfile); ! show_expr (open->access); } if (open->form) { ! fputs (" FORM=", dumpfile); ! show_expr (open->form); } if (open->recl) { ! fputs (" RECL=", dumpfile); ! show_expr (open->recl); } if (open->blank) { ! fputs (" BLANK=", dumpfile); ! show_expr (open->blank); } if (open->position) { ! fputs (" POSITION=", dumpfile); ! show_expr (open->position); } if (open->action) { ! fputs (" ACTION=", dumpfile); ! show_expr (open->action); } if (open->delim) { ! fputs (" DELIM=", dumpfile); ! show_expr (open->delim); } if (open->pad) { ! fputs (" PAD=", dumpfile); ! show_expr (open->pad); ! } ! if (open->decimal) ! { ! fputs (" DECIMAL=", dumpfile); ! show_expr (open->decimal); ! } ! if (open->encoding) ! { ! fputs (" ENCODING=", dumpfile); ! show_expr (open->encoding); ! } ! if (open->round) ! { ! fputs (" ROUND=", dumpfile); ! show_expr (open->round); ! } ! if (open->sign) ! { ! fputs (" SIGN=", dumpfile); ! show_expr (open->sign); } if (open->convert) { ! fputs (" CONVERT=", dumpfile); ! show_expr (open->convert); ! } ! if (open->asynchronous) ! { ! fputs (" ASYNCHRONOUS=", dumpfile); ! show_expr (open->asynchronous); } if (open->err != NULL) ! fprintf (dumpfile, " ERR=%d", open->err->value); break; case EXEC_CLOSE: ! fputs ("CLOSE", dumpfile); close = c->ext.close; if (close->unit) { ! fputs (" UNIT=", dumpfile); ! show_expr (close->unit); } if (close->iomsg) { ! fputs (" IOMSG=", dumpfile); ! show_expr (close->iomsg); } if (close->iostat) { ! fputs (" IOSTAT=", dumpfile); ! show_expr (close->iostat); } if (close->status) { ! fputs (" STATUS=", dumpfile); ! show_expr (close->status); } if (close->err != NULL) ! fprintf (dumpfile, " ERR=%d", close->err->value); break; case EXEC_BACKSPACE: ! fputs ("BACKSPACE", dumpfile); goto show_filepos; case EXEC_ENDFILE: ! fputs ("ENDFILE", dumpfile); goto show_filepos; case EXEC_REWIND: ! fputs ("REWIND", dumpfile); goto show_filepos; case EXEC_FLUSH: ! fputs ("FLUSH", dumpfile); show_filepos: fp = c->ext.filepos; if (fp->unit) { ! fputs (" UNIT=", dumpfile); ! show_expr (fp->unit); } if (fp->iomsg) { ! fputs (" IOMSG=", dumpfile); ! show_expr (fp->iomsg); } if (fp->iostat) { ! fputs (" IOSTAT=", dumpfile); ! show_expr (fp->iostat); } if (fp->err != NULL) ! fprintf (dumpfile, " ERR=%d", fp->err->value); break; case EXEC_INQUIRE: ! fputs ("INQUIRE", dumpfile); i = c->ext.inquire; if (i->unit) { ! fputs (" UNIT=", dumpfile); ! show_expr (i->unit); } if (i->file) { ! fputs (" FILE=", dumpfile); ! show_expr (i->file); } if (i->iomsg) { ! fputs (" IOMSG=", dumpfile); ! show_expr (i->iomsg); } if (i->iostat) { ! fputs (" IOSTAT=", dumpfile); ! show_expr (i->iostat); } if (i->exist) { ! fputs (" EXIST=", dumpfile); ! show_expr (i->exist); } if (i->opened) { ! fputs (" OPENED=", dumpfile); ! show_expr (i->opened); } if (i->number) { ! fputs (" NUMBER=", dumpfile); ! show_expr (i->number); } if (i->named) { ! fputs (" NAMED=", dumpfile); ! show_expr (i->named); } if (i->name) { ! fputs (" NAME=", dumpfile); ! show_expr (i->name); } if (i->access) { ! fputs (" ACCESS=", dumpfile); ! show_expr (i->access); } if (i->sequential) { ! fputs (" SEQUENTIAL=", dumpfile); ! show_expr (i->sequential); } if (i->direct) { ! fputs (" DIRECT=", dumpfile); ! show_expr (i->direct); } if (i->form) { ! fputs (" FORM=", dumpfile); ! show_expr (i->form); } if (i->formatted) { ! fputs (" FORMATTED", dumpfile); ! show_expr (i->formatted); } if (i->unformatted) { ! fputs (" UNFORMATTED=", dumpfile); ! show_expr (i->unformatted); } if (i->recl) { ! fputs (" RECL=", dumpfile); ! show_expr (i->recl); } if (i->nextrec) { ! fputs (" NEXTREC=", dumpfile); ! show_expr (i->nextrec); } if (i->blank) { ! fputs (" BLANK=", dumpfile); ! show_expr (i->blank); } if (i->position) { ! fputs (" POSITION=", dumpfile); ! show_expr (i->position); } if (i->action) { ! fputs (" ACTION=", dumpfile); ! show_expr (i->action); } if (i->read) { ! fputs (" READ=", dumpfile); ! show_expr (i->read); } if (i->write) { ! fputs (" WRITE=", dumpfile); ! show_expr (i->write); } if (i->readwrite) { ! fputs (" READWRITE=", dumpfile); ! show_expr (i->readwrite); } if (i->delim) { ! fputs (" DELIM=", dumpfile); ! show_expr (i->delim); } if (i->pad) { ! fputs (" PAD=", dumpfile); ! show_expr (i->pad); } if (i->convert) { ! fputs (" CONVERT=", dumpfile); ! show_expr (i->convert); ! } ! if (i->asynchronous) ! { ! fputs (" ASYNCHRONOUS=", dumpfile); ! show_expr (i->asynchronous); ! } ! if (i->decimal) ! { ! fputs (" DECIMAL=", dumpfile); ! show_expr (i->decimal); ! } ! if (i->encoding) ! { ! fputs (" ENCODING=", dumpfile); ! show_expr (i->encoding); ! } ! if (i->pending) ! { ! fputs (" PENDING=", dumpfile); ! show_expr (i->pending); ! } ! if (i->round) ! { ! fputs (" ROUND=", dumpfile); ! show_expr (i->round); ! } ! if (i->sign) ! { ! fputs (" SIGN=", dumpfile); ! show_expr (i->sign); ! } ! if (i->size) ! { ! fputs (" SIZE=", dumpfile); ! show_expr (i->size); ! } ! if (i->id) ! { ! fputs (" ID=", dumpfile); ! show_expr (i->id); } if (i->err != NULL) ! fprintf (dumpfile, " ERR=%d", i->err->value); break; case EXEC_IOLENGTH: ! fputs ("IOLENGTH ", dumpfile); ! show_expr (c->expr); goto show_dt_code; break; case EXEC_READ: ! fputs ("READ", dumpfile); goto show_dt; case EXEC_WRITE: ! fputs ("WRITE", dumpfile); show_dt: dt = c->ext.dt; if (dt->io_unit) { ! fputs (" UNIT=", dumpfile); ! show_expr (dt->io_unit); } if (dt->format_expr) { ! fputs (" FMT=", dumpfile); ! show_expr (dt->format_expr); } if (dt->format_label != NULL) ! fprintf (dumpfile, " FMT=%d", dt->format_label->value); if (dt->namelist) ! fprintf (dumpfile, " NML=%s", dt->namelist->name); if (dt->iomsg) { ! fputs (" IOMSG=", dumpfile); ! show_expr (dt->iomsg); } if (dt->iostat) { ! fputs (" IOSTAT=", dumpfile); ! show_expr (dt->iostat); } if (dt->size) { ! fputs (" SIZE=", dumpfile); ! show_expr (dt->size); } if (dt->rec) { ! fputs (" REC=", dumpfile); ! show_expr (dt->rec); } if (dt->advance) { ! fputs (" ADVANCE=", dumpfile); ! show_expr (dt->advance); ! } ! if (dt->id) ! { ! fputs (" ID=", dumpfile); ! show_expr (dt->id); ! } ! if (dt->pos) ! { ! fputs (" POS=", dumpfile); ! show_expr (dt->pos); ! } ! if (dt->asynchronous) ! { ! fputs (" ASYNCHRONOUS=", dumpfile); ! show_expr (dt->asynchronous); ! } ! if (dt->blank) ! { ! fputs (" BLANK=", dumpfile); ! show_expr (dt->blank); ! } ! if (dt->decimal) ! { ! fputs (" DECIMAL=", dumpfile); ! show_expr (dt->decimal); ! } ! if (dt->delim) ! { ! fputs (" DELIM=", dumpfile); ! show_expr (dt->delim); ! } ! if (dt->pad) ! { ! fputs (" PAD=", dumpfile); ! show_expr (dt->pad); ! } ! if (dt->round) ! { ! fputs (" ROUND=", dumpfile); ! show_expr (dt->round); ! } ! if (dt->sign) ! { ! fputs (" SIGN=", dumpfile); ! show_expr (dt->sign); } show_dt_code: ! fputc ('\n', dumpfile); for (c = c->block->next; c; c = c->next) ! show_code_node (level + (c->next != NULL), c); return; case EXEC_TRANSFER: ! fputs ("TRANSFER ", dumpfile); ! show_expr (c->expr); break; case EXEC_DT_END: ! fputs ("DT_END", dumpfile); dt = c->ext.dt; if (dt->err != NULL) ! fprintf (dumpfile, " ERR=%d", dt->err->value); if (dt->end != NULL) ! fprintf (dumpfile, " END=%d", dt->end->value); if (dt->eor != NULL) ! fprintf (dumpfile, " EOR=%d", dt->eor->value); break; case EXEC_OMP_ATOMIC: *************** gfc_show_code_node (int level, gfc_code *** 1715,1753 **** case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: case EXEC_OMP_WORKSHARE: ! gfc_show_omp_node (level, c); break; default: ! gfc_internal_error ("gfc_show_code_node(): Bad statement code"); } ! gfc_status_char ('\n'); } /* Show an equivalence chain. */ ! void ! gfc_show_equiv (gfc_equiv *eq) { show_indent (); ! gfc_status ("Equivalence: "); while (eq) { ! gfc_show_expr (eq->expr); eq = eq->eq; if (eq) ! gfc_status (", "); } } ! /* Show a freakin' whole namespace. */ ! void ! gfc_show_namespace (gfc_namespace *ns) { gfc_interface *intr; gfc_namespace *save; --- 1917,1957 ---- case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: + case EXEC_OMP_TASK: + case EXEC_OMP_TASKWAIT: case EXEC_OMP_WORKSHARE: ! show_omp_node (level, c); break; default: ! gfc_internal_error ("show_code_node(): Bad statement code"); } ! fputc ('\n', dumpfile); } /* Show an equivalence chain. */ ! static void ! show_equiv (gfc_equiv *eq) { show_indent (); ! fputs ("Equivalence: ", dumpfile); while (eq) { ! show_expr (eq->expr); eq = eq->eq; if (eq) ! fputs (", ", dumpfile); } } ! /* Show a freakin' whole namespace. */ ! static void ! show_namespace (gfc_namespace *ns) { gfc_interface *intr; gfc_namespace *save; *************** gfc_show_namespace (gfc_namespace *ns) *** 1759,1765 **** show_level++; show_indent (); ! gfc_status ("Namespace:"); if (ns != NULL) { --- 1963,1969 ---- show_level++; show_indent (); ! fputs ("Namespace:", dumpfile); if (ns != NULL) { *************** gfc_show_namespace (gfc_namespace *ns) *** 1773,1790 **** i++; if (i > l) ! gfc_status(" %c-%c: ", l+'A', i+'A'); else ! gfc_status(" %c: ", l+'A'); ! gfc_show_typespec(&ns->default_type[l]); i++; } while (i < GFC_LETTERS); if (ns->proc_name != NULL) { show_indent (); ! gfc_status ("procedure name = %s", ns->proc_name->name); } gfc_current_ns = ns; --- 1977,1994 ---- i++; if (i > l) ! fprintf (dumpfile, " %c-%c: ", l+'A', i+'A'); else ! fprintf (dumpfile, " %c: ", l+'A'); ! show_typespec(&ns->default_type[l]); i++; } while (i < GFC_LETTERS); if (ns->proc_name != NULL) { show_indent (); ! fprintf (dumpfile, "procedure name = %s", ns->proc_name->name); } gfc_current_ns = ns; *************** gfc_show_namespace (gfc_namespace *ns) *** 1795,1835 **** for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++) { /* User operator interfaces */ ! intr = ns->operator[op]; if (intr == NULL) continue; show_indent (); ! gfc_status ("Operator interfaces for %s:", gfc_op2string (op)); for (; intr; intr = intr->next) ! gfc_status (" %s", intr->sym->name); } if (ns->uop_root != NULL) { show_indent (); ! gfc_status ("User operators:\n"); gfc_traverse_user_op (ns, show_uop); } } for (eq = ns->equiv; eq; eq = eq->next) ! gfc_show_equiv (eq); ! gfc_status_char ('\n'); ! gfc_status_char ('\n'); ! gfc_show_code (0, ns->code); for (ns = ns->contained; ns; ns = ns->sibling) { show_indent (); ! gfc_status ("CONTAINS\n"); ! gfc_show_namespace (ns); } show_level--; ! gfc_status_char ('\n'); gfc_current_ns = save; } --- 1999,2050 ---- for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++) { /* User operator interfaces */ ! intr = ns->op[op]; if (intr == NULL) continue; show_indent (); ! fprintf (dumpfile, "Operator interfaces for %s:", ! gfc_op2string (op)); for (; intr; intr = intr->next) ! fprintf (dumpfile, " %s", intr->sym->name); } if (ns->uop_root != NULL) { show_indent (); ! fputs ("User operators:\n", dumpfile); gfc_traverse_user_op (ns, show_uop); } } for (eq = ns->equiv; eq; eq = eq->next) ! show_equiv (eq); ! fputc ('\n', dumpfile); ! fputc ('\n', dumpfile); ! show_code (0, ns->code); for (ns = ns->contained; ns; ns = ns->sibling) { show_indent (); ! fputs ("CONTAINS\n", dumpfile); ! show_namespace (ns); } show_level--; ! fputc ('\n', dumpfile); gfc_current_ns = save; } + + + /* Main function for dumping a parse tree. */ + + void + gfc_dump_parse_tree (gfc_namespace *ns, FILE *file) + { + dumpfile = file; + show_namespace (ns); + } diff -Nrcpad gcc-4.3.3/gcc/fortran/error.c gcc-4.4.0/gcc/fortran/error.c *** gcc-4.3.3/gcc/fortran/error.c Sun Dec 21 15:45:52 2008 --- gcc-4.4.0/gcc/fortran/error.c Mon Dec 15 14:46:22 2008 *************** *** 1,5 **** /* Handle errors. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught & Niels Kristian Bech Jensen --- 1,5 ---- /* Handle errors. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Andy Vaught & Niels Kristian Bech Jensen *************** along with GCC; see the file COPYING3. *** 30,42 **** #include "flags.h" #include "gfortran.h" ! int gfc_suppress_error = 0; static int terminal_width, buffer_flag, errors, warnings; static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer; /* Per-file error initialization. */ void --- 30,62 ---- #include "flags.h" #include "gfortran.h" ! static int suppress_errors = 0; static int terminal_width, buffer_flag, errors, warnings; static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer; + /* Go one level deeper suppressing errors. */ + + void + gfc_push_suppress_errors (void) + { + gcc_assert (suppress_errors >= 0); + ++suppress_errors; + } + + + /* Leave one level of error suppressing. */ + + void + gfc_pop_suppress_errors (void) + { + gcc_assert (suppress_errors > 0); + --suppress_errors; + } + + /* Per-file error initialization. */ void *************** error_char (char c) *** 70,77 **** { cur_error_buffer->allocated = cur_error_buffer->allocated ? cur_error_buffer->allocated * 2 : 1000; ! cur_error_buffer->message = xrealloc (cur_error_buffer->message, ! cur_error_buffer->allocated); } cur_error_buffer->message[cur_error_buffer->index++] = c; } --- 90,97 ---- { cur_error_buffer->allocated = cur_error_buffer->allocated ? cur_error_buffer->allocated * 2 : 1000; ! cur_error_buffer->message = XRESIZEVEC (char, cur_error_buffer->message, ! cur_error_buffer->allocated); } cur_error_buffer->message[cur_error_buffer->index++] = c; } *************** error_char (char c) *** 87,93 **** if (index + 1 >= allocated) { allocated = allocated ? allocated * 2 : 1000; ! line = xrealloc (line, allocated); } line[index++] = c; if (c == '\n') --- 107,113 ---- if (index + 1 >= allocated) { allocated = allocated ? allocated * 2 : 1000; ! line = XRESIZEVEC (char, line, allocated); } line[index++] = c; if (c == '\n') *************** error_integer (long int i) *** 152,157 **** --- 172,246 ---- } + static void + print_wide_char_into_buffer (gfc_char_t c, char *buf) + { + static const char xdigit[16] = { '0', '1', '2', '3', '4', '5', '6', + '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' }; + + if (gfc_wide_is_printable (c)) + { + buf[1] = '\0'; + buf[0] = (unsigned char) c; + } + else if (c < ((gfc_char_t) 1 << 8)) + { + buf[4] = '\0'; + buf[3] = xdigit[c & 0x0F]; + c = c >> 4; + buf[2] = xdigit[c & 0x0F]; + + buf[1] = 'x'; + buf[0] = '\\'; + } + else if (c < ((gfc_char_t) 1 << 16)) + { + buf[6] = '\0'; + buf[5] = xdigit[c & 0x0F]; + c = c >> 4; + buf[4] = xdigit[c & 0x0F]; + c = c >> 4; + buf[3] = xdigit[c & 0x0F]; + c = c >> 4; + buf[2] = xdigit[c & 0x0F]; + + buf[1] = 'u'; + buf[0] = '\\'; + } + else + { + buf[10] = '\0'; + buf[9] = xdigit[c & 0x0F]; + c = c >> 4; + buf[8] = xdigit[c & 0x0F]; + c = c >> 4; + buf[7] = xdigit[c & 0x0F]; + c = c >> 4; + buf[6] = xdigit[c & 0x0F]; + c = c >> 4; + buf[5] = xdigit[c & 0x0F]; + c = c >> 4; + buf[4] = xdigit[c & 0x0F]; + c = c >> 4; + buf[3] = xdigit[c & 0x0F]; + c = c >> 4; + buf[2] = xdigit[c & 0x0F]; + + buf[1] = 'U'; + buf[0] = '\\'; + } + } + + static char wide_char_print_buffer[11]; + + const char * + gfc_print_wide_char (gfc_char_t c) + { + print_wide_char_into_buffer (c, wide_char_print_buffer); + return wide_char_print_buffer; + } + + /* Show the file, where it was included, and the source line, give a locus. Calls error_printf() recursively, but the recursion is at most one level deep. */ *************** show_locus (locus *loc, int c1, int c2) *** 163,170 **** { gfc_linebuf *lb; gfc_file *f; ! char c, *p; ! int i, m, offset, cmax; /* TODO: Either limit the total length and number of included files displayed or add buffering of arbitrary number of characters in --- 252,259 ---- { gfc_linebuf *lb; gfc_file *f; ! gfc_char_t c, *p; ! int i, offset, cmax; /* TODO: Either limit the total length and number of included files displayed or add buffering of arbitrary number of characters in *************** show_locus (locus *loc, int c1, int c2) *** 182,192 **** error_string (f->filename); error_char (':'); - #ifdef USE_MAPPED_LOCATION error_integer (LOCATION_LINE (lb->location)); - #else - error_integer (lb->linenum); - #endif if ((c1 > 0) || (c2 > 0)) error_char ('.'); --- 271,277 ---- *************** show_locus (locus *loc, int c1, int c2) *** 242,275 **** to work correctly when nonprintable characters exist. A better solution should be found. */ ! p = lb->line + offset; ! i = strlen (p); if (i > terminal_width) i = terminal_width - 1; for (; i > 0; i--) { c = *p++; if (c == '\t') c = ' '; ! if (ISPRINT (c)) ! error_char (c); ! else ! { ! error_char ('\\'); ! error_char ('x'); ! ! m = ((c >> 4) & 0x0F) + '0'; ! if (m > '9') ! m += 'A' - '9' - 1; ! error_char (m); ! ! m = (c & 0x0F) + '0'; ! if (m > '9') ! m += 'A' - '9' - 1; ! error_char (m); ! } } error_char ('\n'); --- 327,347 ---- to work correctly when nonprintable characters exist. A better solution should be found. */ ! p = &(lb->line[offset]); ! i = gfc_wide_strlen (p); if (i > terminal_width) i = terminal_width - 1; for (; i > 0; i--) { + static char buffer[11]; + c = *p++; if (c == '\t') c = ' '; ! print_wide_char_into_buffer (c, buffer); ! error_string (buffer); } error_char ('\n'); *************** gfc_notification_std (int std) *** 694,700 **** standard does not contain the requested bits. Return FAILURE if an error is generated. */ ! try gfc_notify_std (int std, const char *nocmsgid, ...) { va_list argp; --- 766,772 ---- standard does not contain the requested bits. Return FAILURE if an error is generated. */ ! gfc_try gfc_notify_std (int std, const char *nocmsgid, ...) { va_list argp; *************** gfc_notify_std (int std, const char *noc *** 704,710 **** if ((gfc_option.allow_std & std) != 0 && !warning) return SUCCESS; ! if (gfc_suppress_error) return warning ? SUCCESS : FAILURE; cur_error_buffer = warning ? &warning_buffer : &error_buffer; --- 776,782 ---- if ((gfc_option.allow_std & std) != 0 && !warning) return SUCCESS; ! if (suppress_errors) return warning ? SUCCESS : FAILURE; cur_error_buffer = warning ? &warning_buffer : &error_buffer; *************** gfc_error (const char *nocmsgid, ...) *** 790,796 **** { va_list argp; ! if (gfc_suppress_error) return; error_buffer.flag = 1; --- 862,868 ---- { va_list argp; ! if (suppress_errors) return; error_buffer.flag = 1; *************** gfc_free_error (gfc_error_buf *err) *** 959,989 **** } - /* Debug wrapper for printf. */ - - void - gfc_status (const char *cmsgid, ...) - { - va_list argp; - - va_start (argp, cmsgid); - - vprintf (_(cmsgid), argp); - - va_end (argp); - } - - - /* Subroutine for outputting a single char so that we don't have to go - around creating a lot of 1-character strings. */ - - void - gfc_status_char (char c) - { - putchar (c); - } - - /* Report the number of warnings and errors that occurred to the caller. */ void --- 1031,1036 ---- diff -Nrcpad gcc-4.3.3/gcc/fortran/expr.c gcc-4.4.0/gcc/fortran/expr.c *** gcc-4.3.3/gcc/fortran/expr.c Thu Jan 1 17:42:00 2009 --- gcc-4.4.0/gcc/fortran/expr.c Fri Feb 20 15:20:38 2009 *************** *** 1,5 **** /* Routines for manipulation of expression nodes. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Routines for manipulation of expression nodes. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught *************** gfc_get_expr (void) *** 33,39 **** { gfc_expr *e; ! e = gfc_getmem (sizeof (gfc_expr)); gfc_clear_ts (&e->ts); e->shape = NULL; e->ref = NULL; --- 33,39 ---- { gfc_expr *e; ! e = XCNEW (gfc_expr); gfc_clear_ts (&e->ts); e->shape = NULL; e->ref = NULL; *************** gfc_free_actual_arglist (gfc_actual_argl *** 65,88 **** gfc_actual_arglist * gfc_copy_actual_arglist (gfc_actual_arglist *p) { ! gfc_actual_arglist *head, *tail, *new; head = tail = NULL; for (; p; p = p->next) { ! new = gfc_get_actual_arglist (); ! *new = *p; ! new->expr = gfc_copy_expr (p->expr); ! new->next = NULL; if (head == NULL) ! head = new; else ! tail->next = new; ! tail = new; } return head; --- 65,88 ---- gfc_actual_arglist * gfc_copy_actual_arglist (gfc_actual_arglist *p) { ! gfc_actual_arglist *head, *tail, *new_arg; head = tail = NULL; for (; p; p = p->next) { ! new_arg = gfc_get_actual_arglist (); ! *new_arg = *p; ! new_arg->expr = gfc_copy_expr (p->expr); ! new_arg->next = NULL; if (head == NULL) ! head = new_arg; else ! tail->next = new_arg; ! tail = new_arg; } return head; *************** free_expr0 (gfc_expr *e) *** 164,172 **** break; } ! /* Free the representation, except in character constants where it ! is the same as value.character.string and thus already freed. */ ! if (e->representation.string && e->ts.type != BT_CHARACTER) gfc_free (e->representation.string); break; --- 164,171 ---- break; } ! /* Free the representation. */ ! if (e->representation.string) gfc_free (e->representation.string); break; *************** free_expr0 (gfc_expr *e) *** 182,187 **** --- 181,190 ---- gfc_free_actual_arglist (e->value.function.actual); break; + case EXPR_COMPCALL: + gfc_free_actual_arglist (e->value.compcall.actual); + break; + case EXPR_VARIABLE: break; *************** gfc_extract_int (gfc_expr *expr, int *re *** 269,276 **** /* Recursively copy a list of reference structures. */ ! static gfc_ref * ! copy_ref (gfc_ref *src) { gfc_array_ref *ar; gfc_ref *dest; --- 272,279 ---- /* Recursively copy a list of reference structures. */ ! gfc_ref * ! gfc_copy_ref (gfc_ref *src) { gfc_array_ref *ar; gfc_ref *dest; *************** copy_ref (gfc_ref *src) *** 300,306 **** break; } ! dest->next = copy_ref (src->next); return dest; } --- 303,309 ---- break; } ! dest->next = gfc_copy_ref (src->next); return dest; } *************** gfc_expr * *** 393,399 **** gfc_copy_expr (gfc_expr *p) { gfc_expr *q; ! char *s; if (p == NULL) return NULL; --- 396,403 ---- gfc_copy_expr (gfc_expr *p) { gfc_expr *q; ! gfc_char_t *s; ! char *c; if (p == NULL) return NULL; *************** gfc_copy_expr (gfc_expr *p) *** 404,423 **** switch (q->expr_type) { case EXPR_SUBSTRING: ! s = gfc_getmem (p->value.character.length + 1); q->value.character.string = s; ! ! memcpy (s, p->value.character.string, p->value.character.length + 1); break; case EXPR_CONSTANT: /* Copy target representation, if it exists. */ if (p->representation.string) { ! s = gfc_getmem (p->representation.length + 1); ! q->representation.string = s; ! ! memcpy (s, p->representation.string, p->representation.length + 1); } /* Copy the values of any pointer components of p->value. */ --- 408,426 ---- switch (q->expr_type) { case EXPR_SUBSTRING: ! s = gfc_get_wide_string (p->value.character.length + 1); q->value.character.string = s; ! memcpy (s, p->value.character.string, ! (p->value.character.length + 1) * sizeof (gfc_char_t)); break; case EXPR_CONSTANT: /* Copy target representation, if it exists. */ if (p->representation.string) { ! c = XCNEWVEC (char, p->representation.length + 1); ! q->representation.string = c; ! memcpy (c, p->representation.string, (p->representation.length + 1)); } /* Copy the values of any pointer components of p->value. */ *************** gfc_copy_expr (gfc_expr *p) *** 443,452 **** case BT_CHARACTER: if (p->representation.string) ! q->value.character.string = q->representation.string; else { ! s = gfc_getmem (p->value.character.length + 1); q->value.character.string = s; /* This is the case for the C_NULL_CHAR named constant. */ --- 446,456 ---- case BT_CHARACTER: if (p->representation.string) ! q->value.character.string ! = gfc_char_to_widechar (q->representation.string); else { ! s = gfc_get_wide_string (p->value.character.length + 1); q->value.character.string = s; /* This is the case for the C_NULL_CHAR named constant. */ *************** gfc_copy_expr (gfc_expr *p) *** 460,466 **** } else memcpy (s, p->value.character.string, ! p->value.character.length + 1); } break; --- 464,470 ---- } else memcpy (s, p->value.character.string, ! (p->value.character.length + 1) * sizeof (gfc_char_t)); } break; *************** gfc_copy_expr (gfc_expr *p) *** 480,486 **** break; case EXPR_OP: ! switch (q->value.op.operator) { case INTRINSIC_NOT: case INTRINSIC_PARENTHESES: --- 484,490 ---- break; case EXPR_OP: ! switch (q->value.op.op) { case INTRINSIC_NOT: case INTRINSIC_PARENTHESES: *************** gfc_copy_expr (gfc_expr *p) *** 502,507 **** --- 506,517 ---- gfc_copy_actual_arglist (p->value.function.actual); break; + case EXPR_COMPCALL: + q->value.compcall.actual = + gfc_copy_actual_arglist (p->value.compcall.actual); + q->value.compcall.tbp = p->value.compcall.tbp; + break; + case EXPR_STRUCTURE: case EXPR_ARRAY: q->value.constructor = gfc_copy_constructor (p->value.constructor); *************** gfc_copy_expr (gfc_expr *p) *** 514,520 **** q->shape = gfc_copy_shape (p->shape, p->rank); ! q->ref = copy_ref (p->ref); return q; } --- 524,530 ---- q->shape = gfc_copy_shape (p->shape, p->rank); ! q->ref = gfc_copy_ref (p->ref); return q; } *************** gfc_type_convert_binary (gfc_expr *e) *** 659,665 **** e->ts = op1->ts; /* Special case for ** operator. */ ! if (e->value.op.operator == INTRINSIC_POWER) goto done; gfc_convert_type (e->value.op.op2, &e->ts, 2); --- 669,675 ---- e->ts = op1->ts; /* Special case for ** operator. */ ! if (e->value.op.op == INTRINSIC_POWER) goto done; gfc_convert_type (e->value.op.op2, &e->ts, 2); *************** is_subref_array (gfc_expr * e) *** 824,841 **** /* Try to collapse intrinsic expressions. */ ! static try simplify_intrinsic_op (gfc_expr *p, int type) { gfc_intrinsic_op op; gfc_expr *op1, *op2, *result; ! if (p->value.op.operator == INTRINSIC_USER) return SUCCESS; op1 = p->value.op.op1; op2 = p->value.op.op2; ! op = p->value.op.operator; if (gfc_simplify_expr (op1, type) == FAILURE) return FAILURE; --- 834,851 ---- /* Try to collapse intrinsic expressions. */ ! static gfc_try simplify_intrinsic_op (gfc_expr *p, int type) { gfc_intrinsic_op op; gfc_expr *op1, *op2, *result; ! if (p->value.op.op == INTRINSIC_USER) return SUCCESS; op1 = p->value.op.op1; op2 = p->value.op.op2; ! op = p->value.op.op; if (gfc_simplify_expr (op1, type) == FAILURE) return FAILURE; *************** simplify_intrinsic_op (gfc_expr *p, int *** 960,966 **** /* Subroutine to simplify constructor expressions. Mutually recursive with gfc_simplify_expr(). */ ! static try simplify_constructor (gfc_constructor *c, int type) { gfc_expr *p; --- 970,976 ---- /* Subroutine to simplify constructor expressions. Mutually recursive with gfc_simplify_expr(). */ ! static gfc_try simplify_constructor (gfc_constructor *c, int type) { gfc_expr *p; *************** simplify_constructor (gfc_constructor *c *** 996,1002 **** /* Pull a single array element out of an array constructor. */ ! static try find_array_element (gfc_constructor *cons, gfc_array_ref *ar, gfc_constructor **rval) { --- 1006,1012 ---- /* Pull a single array element out of an array constructor. */ ! static gfc_try find_array_element (gfc_constructor *cons, gfc_array_ref *ar, gfc_constructor **rval) { *************** find_array_element (gfc_constructor *con *** 1007,1013 **** mpz_t span; mpz_t tmp; gfc_expr *e; ! try t; t = SUCCESS; e = NULL; --- 1017,1023 ---- mpz_t span; mpz_t tmp; gfc_expr *e; ! gfc_try t; t = SUCCESS; e = NULL; *************** find_array_element (gfc_constructor *con *** 1060,1068 **** mpz_mul (span, span, tmp); } ! if (cons) { ! for (nelemen = mpz_get_ui (offset); nelemen > 0; nelemen--) { if (cons->iterator) { --- 1070,1078 ---- mpz_mul (span, span, tmp); } ! for (nelemen = mpz_get_ui (offset); nelemen > 0; nelemen--) { ! if (cons) { if (cons->iterator) { *************** remove_subobject_ref (gfc_expr *p, gfc_c *** 1123,1129 **** /* Pull an array section out of an array constructor. */ ! static try find_array_section (gfc_expr *expr, gfc_ref *ref) { int idx; --- 1133,1139 ---- /* Pull an array section out of an array constructor. */ ! static gfc_try find_array_section (gfc_expr *expr, gfc_ref *ref) { int idx; *************** find_array_section (gfc_expr *expr, gfc_ *** 1150,1156 **** gfc_expr *upper; gfc_expr *lower; gfc_constructor *vecsub[GFC_MAX_DIMENSIONS], *c; ! try t; t = SUCCESS; --- 1160,1166 ---- gfc_expr *upper; gfc_expr *lower; gfc_constructor *vecsub[GFC_MAX_DIMENSIONS], *c; ! gfc_try t; t = SUCCESS; *************** find_array_section (gfc_expr *expr, gfc_ *** 1350,1356 **** cons = base; } ! while (mpz_cmp (ptr, index) > 0) { mpz_add_ui (index, index, one); cons = cons->next; --- 1360,1366 ---- cons = base; } ! while (cons && cons->next && mpz_cmp (ptr, index) > 0) { mpz_add_ui (index, index, one); cons = cons->next; *************** cleanup: *** 1381,1393 **** /* Pull a substring out of an expression. */ ! static try find_substring_ref (gfc_expr *p, gfc_expr **newp) { int end; int start; int length; ! char *chr; if (p->ref->u.ss.start->expr_type != EXPR_CONSTANT || p->ref->u.ss.end->expr_type != EXPR_CONSTANT) --- 1391,1403 ---- /* Pull a substring out of an expression. */ ! static gfc_try find_substring_ref (gfc_expr *p, gfc_expr **newp) { int end; int start; int length; ! gfc_char_t *chr; if (p->ref->u.ss.start->expr_type != EXPR_CONSTANT || p->ref->u.ss.end->expr_type != EXPR_CONSTANT) *************** find_substring_ref (gfc_expr *p, gfc_exp *** 1400,1408 **** start = (int) mpz_get_ui (p->ref->u.ss.start->value.integer); length = end - start + 1; ! chr = (*newp)->value.character.string = gfc_getmem (length + 1); (*newp)->value.character.length = length; ! memcpy (chr, &p->value.character.string[start - 1], length); chr[length] = '\0'; return SUCCESS; } --- 1410,1419 ---- start = (int) mpz_get_ui (p->ref->u.ss.start->value.integer); length = end - start + 1; ! chr = (*newp)->value.character.string = gfc_get_wide_string (length + 1); (*newp)->value.character.length = length; ! memcpy (chr, &p->value.character.string[start - 1], ! length * sizeof (gfc_char_t)); chr[length] = '\0'; return SUCCESS; } *************** find_substring_ref (gfc_expr *p, gfc_exp *** 1412,1418 **** /* Simplify a subobject reference of a constructor. This occurs when parameter variable values are substituted. */ ! static try simplify_const_ref (gfc_expr *p) { gfc_constructor *cons; --- 1423,1429 ---- /* Simplify a subobject reference of a constructor. This occurs when parameter variable values are substituted. */ ! static gfc_try simplify_const_ref (gfc_expr *p) { gfc_constructor *cons; *************** simplify_const_ref (gfc_expr *p) *** 1450,1457 **** cons = p->value.constructor; for (; cons; cons = cons->next) { ! cons->expr->ref = copy_ref (p->ref->next); ! simplify_const_ref (cons->expr); if (simplify_const_ref (cons->expr) == FAILURE) return FAILURE; } --- 1461,1467 ---- cons = p->value.constructor; for (; cons; cons = cons->next) { ! cons->expr->ref = gfc_copy_ref (p->ref->next); if (simplify_const_ref (cons->expr) == FAILURE) return FAILURE; } *************** simplify_const_ref (gfc_expr *p) *** 1520,1526 **** /* Simplify a chain of references. */ ! static try simplify_ref_chain (gfc_ref *ref, int type) { int n; --- 1530,1536 ---- /* Simplify a chain of references. */ ! static gfc_try simplify_ref_chain (gfc_ref *ref, int type) { int n; *************** simplify_ref_chain (gfc_ref *ref, int ty *** 1558,1568 **** /* Try to substitute the value of a parameter variable. */ ! static try simplify_parameter_variable (gfc_expr *p, int type) { gfc_expr *e; ! try t; e = gfc_copy_expr (p->symtree->n.sym->value); if (e == NULL) --- 1568,1578 ---- /* Try to substitute the value of a parameter variable. */ ! static gfc_try simplify_parameter_variable (gfc_expr *p, int type) { gfc_expr *e; ! gfc_try t; e = gfc_copy_expr (p->symtree->n.sym->value); if (e == NULL) *************** simplify_parameter_variable (gfc_expr *p *** 1572,1578 **** /* Do not copy subobject refs for constant. */ if (e->expr_type != EXPR_CONSTANT && p->ref != NULL) ! e->ref = copy_ref (p->ref); t = gfc_simplify_expr (e, type); /* Only use the simplification if it eliminated all subobject references. */ --- 1582,1588 ---- /* Do not copy subobject refs for constant. */ if (e->expr_type != EXPR_CONSTANT && p->ref != NULL) ! e->ref = gfc_copy_ref (p->ref); t = gfc_simplify_expr (e, type); /* Only use the simplification if it eliminated all subobject references. */ *************** simplify_parameter_variable (gfc_expr *p *** 1603,1609 **** Returns FAILURE on error, SUCCESS otherwise. NOTE: Will return SUCCESS even if the expression can not be simplified. */ ! try gfc_simplify_expr (gfc_expr *p, int type) { gfc_actual_arglist *ap; --- 1613,1619 ---- Returns FAILURE on error, SUCCESS otherwise. NOTE: Will return SUCCESS even if the expression can not be simplified. */ ! gfc_try gfc_simplify_expr (gfc_expr *p, int type) { gfc_actual_arglist *ap; *************** gfc_simplify_expr (gfc_expr *p, int type *** 1634,1640 **** if (gfc_is_constant_expr (p)) { ! char *s; int start, end; if (p->ref && p->ref->u.ss.start) --- 1644,1650 ---- if (gfc_is_constant_expr (p)) { ! gfc_char_t *s; int start, end; if (p->ref && p->ref->u.ss.start) *************** gfc_simplify_expr (gfc_expr *p, int type *** 1650,1657 **** else end = p->value.character.length; ! s = gfc_getmem (end - start + 2); ! memcpy (s, p->value.character.string + start, end - start); s[end - start + 1] = '\0'; /* TODO: C-style string. */ gfc_free (p->value.character.string); p->value.character.string = s; --- 1660,1668 ---- else end = p->value.character.length; ! s = gfc_get_wide_string (end - start + 2); ! memcpy (s, p->value.character.string + start, ! (end - start) * sizeof (gfc_char_t)); s[end - start + 1] = '\0'; /* TODO: C-style string. */ gfc_free (p->value.character.string); p->value.character.string = s; *************** gfc_simplify_expr (gfc_expr *p, int type *** 1710,1715 **** --- 1721,1730 ---- return FAILURE; break; + + case EXPR_COMPCALL: + gcc_unreachable (); + break; } return SUCCESS; *************** et0 (gfc_expr *e) *** 1733,1744 **** /* Check an intrinsic arithmetic operation to see if it is consistent with some type of expression. */ ! static try check_init_expr (gfc_expr *); /* Scalarize an expression for an elemental intrinsic call. */ ! static try scalarize_intrinsic_call (gfc_expr *e) { gfc_actual_arglist *a, *b; --- 1748,1759 ---- /* Check an intrinsic arithmetic operation to see if it is consistent with some type of expression. */ ! static gfc_try check_init_expr (gfc_expr *); /* Scalarize an expression for an elemental intrinsic call. */ ! static gfc_try scalarize_intrinsic_call (gfc_expr *e) { gfc_actual_arglist *a, *b; *************** cleanup: *** 1871,1878 **** } ! static try ! check_intrinsic_op (gfc_expr *e, try (*check_function) (gfc_expr *)) { gfc_expr *op1 = e->value.op.op1; gfc_expr *op2 = e->value.op.op2; --- 1886,1893 ---- } ! static gfc_try ! check_intrinsic_op (gfc_expr *e, gfc_try (*check_function) (gfc_expr *)) { gfc_expr *op1 = e->value.op.op1; gfc_expr *op2 = e->value.op.op2; *************** check_intrinsic_op (gfc_expr *e, try (*c *** 1880,1886 **** if ((*check_function) (op1) == FAILURE) return FAILURE; ! switch (e->value.op.operator) { case INTRINSIC_UPLUS: case INTRINSIC_UMINUS: --- 1895,1901 ---- if ((*check_function) (op1) == FAILURE) return FAILURE; ! switch (e->value.op.op) { case INTRINSIC_UPLUS: case INTRINSIC_UMINUS: *************** check_intrinsic_op (gfc_expr *e, try (*c *** 1923,1929 **** if (!numeric_type (et0 (op1)) || !numeric_type (et0 (op2))) goto not_numeric; ! if (e->value.op.operator == INTRINSIC_POWER && check_function == check_init_expr && et0 (op2) != BT_INTEGER) { if (gfc_notify_std (GFC_STD_F2003,"Fortran 2003: Noninteger " --- 1938,1944 ---- if (!numeric_type (et0 (op1)) || !numeric_type (et0 (op2))) goto not_numeric; ! if (e->value.op.op == INTRINSIC_POWER && check_function == check_init_expr && et0 (op2) != BT_INTEGER) { if (gfc_notify_std (GFC_STD_F2003,"Fortran 2003: Noninteger " *************** check_init_expr_arguments (gfc_expr *e) *** 2011,2018 **** return MATCH_YES; } ! ! static try check_restricted (gfc_expr *); /* F95, 7.1.6.1, Initialization expressions, (7) F2003, 7.1.7 Initialization expression, (8) */ --- 2026,2032 ---- return MATCH_YES; } ! static gfc_try check_restricted (gfc_expr *); /* F95, 7.1.6.1, Initialization expressions, (7) F2003, 7.1.7 Initialization expression, (8) */ *************** check_conversion (gfc_expr *e) *** 2203,2214 **** intrinsics in the context of initialization expressions. If FAILURE is returned an error message has been generated. */ ! static try check_init_expr (gfc_expr *e) { match m; ! try t; ! gfc_intrinsic_sym *isym; if (e == NULL) return SUCCESS; --- 2217,2227 ---- intrinsics in the context of initialization expressions. If FAILURE is returned an error message has been generated. */ ! static gfc_try check_init_expr (gfc_expr *e) { match m; ! gfc_try t; if (e == NULL) return SUCCESS; *************** check_init_expr (gfc_expr *e) *** 2227,2233 **** if ((m = check_specification_function (e)) != MATCH_YES) { ! if ((m = gfc_intrinsic_func_interface (e, 0)) != MATCH_YES) { gfc_error ("Function '%s' in initialization expression at %L " "must be an intrinsic or a specification function", --- 2240,2251 ---- if ((m = check_specification_function (e)) != MATCH_YES) { ! gfc_intrinsic_sym* isym; ! gfc_symbol* sym; ! ! sym = e->symtree->n.sym; ! if (!gfc_is_intrinsic (sym, 0, e->where) ! || (m = gfc_intrinsic_func_interface (e, 0)) != MATCH_YES) { gfc_error ("Function '%s' in initialization expression at %L " "must be an intrinsic or a specification function", *************** check_init_expr (gfc_expr *e) *** 2249,2255 **** /* Try to scalarize an elemental intrinsic function that has an array argument. */ ! isym = gfc_find_function (e->symtree->n.sym->name); if (isym && isym->elemental && (t = scalarize_intrinsic_call (e)) == SUCCESS) break; --- 2267,2273 ---- /* Try to scalarize an elemental intrinsic function that has an array argument. */ ! isym = gfc_find_function (e->symtree->n.sym->name); if (isym && isym->elemental && (t = scalarize_intrinsic_call (e)) == SUCCESS) break; *************** check_init_expr (gfc_expr *e) *** 2369,2383 **** return t; } - /* Reduces a general expression to an initialization expression (a constant). This used to be part of gfc_match_init_expr. Note that this function doesn't free the given expression on FAILURE. */ ! ! try gfc_reduce_init_expr (gfc_expr *expr) { ! try t; gfc_init_expr = 1; t = gfc_resolve_expr (expr); --- 2387,2400 ---- return t; } /* Reduces a general expression to an initialization expression (a constant). This used to be part of gfc_match_init_expr. Note that this function doesn't free the given expression on FAILURE. */ ! ! gfc_try gfc_reduce_init_expr (gfc_expr *expr) { ! gfc_try t; gfc_init_expr = 1; t = gfc_resolve_expr (expr); *************** gfc_match_init_expr (gfc_expr **result) *** 2414,2420 **** { gfc_expr *expr; match m; ! try t; expr = NULL; --- 2431,2437 ---- { gfc_expr *expr; match m; ! gfc_try t; expr = NULL; *************** gfc_match_init_expr (gfc_expr **result) *** 2439,2445 **** restricted expression and optionally if the expression type is integer or character. */ ! static try restricted_args (gfc_actual_arglist *a) { for (; a; a = a->next) --- 2456,2462 ---- restricted expression and optionally if the expression type is integer or character. */ ! static gfc_try restricted_args (gfc_actual_arglist *a) { for (; a; a = a->next) *************** restricted_args (gfc_actual_arglist *a) *** 2457,2463 **** /* Make sure a non-intrinsic function is a specification function. */ ! static try external_spec_function (gfc_expr *e) { gfc_symbol *f; --- 2474,2480 ---- /* Make sure a non-intrinsic function is a specification function. */ ! static gfc_try external_spec_function (gfc_expr *e) { gfc_symbol *f; *************** external_spec_function (gfc_expr *e) *** 2499,2505 **** /* Check to see that a function reference to an intrinsic is a restricted expression. */ ! static try restricted_intrinsic (gfc_expr *e) { /* TODO: Check constraints on inquiry functions. 7.1.6.2 (7). */ --- 2516,2522 ---- /* Check to see that a function reference to an intrinsic is a restricted expression. */ ! static gfc_try restricted_intrinsic (gfc_expr *e) { /* TODO: Check constraints on inquiry functions. 7.1.6.2 (7). */ *************** restricted_intrinsic (gfc_expr *e) *** 2510,2524 **** } /* Verify that an expression is a restricted expression. Like its cousin check_init_expr(), an error message is generated if we return FAILURE. */ ! static try check_restricted (gfc_expr *e) { ! gfc_symbol *sym; ! try t; if (e == NULL) return SUCCESS; --- 2527,2599 ---- } + /* Check the expressions of an actual arglist. Used by check_restricted. */ + + static gfc_try + check_arglist (gfc_actual_arglist* arg, gfc_try (*checker) (gfc_expr*)) + { + for (; arg; arg = arg->next) + if (checker (arg->expr) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + + /* Check the subscription expressions of a reference chain with a checking + function; used by check_restricted. */ + + static gfc_try + check_references (gfc_ref* ref, gfc_try (*checker) (gfc_expr*)) + { + int dim; + + if (!ref) + return SUCCESS; + + switch (ref->type) + { + case REF_ARRAY: + for (dim = 0; dim != ref->u.ar.dimen; ++dim) + { + if (checker (ref->u.ar.start[dim]) == FAILURE) + return FAILURE; + if (checker (ref->u.ar.end[dim]) == FAILURE) + return FAILURE; + if (checker (ref->u.ar.stride[dim]) == FAILURE) + return FAILURE; + } + break; + + case REF_COMPONENT: + /* Nothing needed, just proceed to next reference. */ + break; + + case REF_SUBSTRING: + if (checker (ref->u.ss.start) == FAILURE) + return FAILURE; + if (checker (ref->u.ss.end) == FAILURE) + return FAILURE; + break; + + default: + gcc_unreachable (); + break; + } + + return check_references (ref->next, checker); + } + + /* Verify that an expression is a restricted expression. Like its cousin check_init_expr(), an error message is generated if we return FAILURE. */ ! static gfc_try check_restricted (gfc_expr *e) { ! gfc_symbol* sym; ! gfc_try t; if (e == NULL) return SUCCESS; *************** check_restricted (gfc_expr *e) *** 2533,2540 **** break; case EXPR_FUNCTION: ! t = e->value.function.esym ? external_spec_function (e) ! : restricted_intrinsic (e); break; case EXPR_VARIABLE: --- 2608,2629 ---- break; case EXPR_FUNCTION: ! if (e->value.function.esym) ! { ! t = check_arglist (e->value.function.actual, &check_restricted); ! if (t == SUCCESS) ! t = external_spec_function (e); ! } ! else ! { ! if (e->value.function.isym && e->value.function.isym->inquiry) ! t = SUCCESS; ! else ! t = check_arglist (e->value.function.actual, &check_restricted); ! ! if (t == SUCCESS) ! t = restricted_intrinsic (e); ! } break; case EXPR_VARIABLE: *************** check_restricted (gfc_expr *e) *** 2568,2573 **** --- 2657,2666 ---- break; } + /* Check reference chain if any. */ + if (check_references (e->ref, &check_restricted) == FAILURE) + break; + /* gfc_is_formal_arg broadcasts that a formal argument list is being processed in resolve.c(resolve_formal_arglist). This is done so that host associated dummy array indices are accepted (PR23446). *************** check_restricted (gfc_expr *e) *** 2578,2583 **** --- 2671,2677 ---- || sym->attr.use_assoc || sym->attr.dummy || sym->attr.implied_index + || sym->attr.flavor == FL_PARAMETER || (sym->ns && sym->ns == gfc_current_ns->parent) || (sym->ns && gfc_current_ns->parent && sym->ns == gfc_current_ns->parent->parent) *************** check_restricted (gfc_expr *e) *** 2630,2636 **** /* Check to see that an expression is a specification expression. If we return FAILURE, an error has been generated. */ ! try gfc_specification_expr (gfc_expr *e) { --- 2724,2730 ---- /* Check to see that an expression is a specification expression. If we return FAILURE, an error has been generated. */ ! gfc_try gfc_specification_expr (gfc_expr *e) { *************** gfc_specification_expr (gfc_expr *e) *** 2639,2645 **** if (e->ts.type != BT_INTEGER) { ! gfc_error ("Expression at %L must be of INTEGER type", &e->where); return FAILURE; } --- 2733,2740 ---- if (e->ts.type != BT_INTEGER) { ! gfc_error ("Expression at %L must be of INTEGER type, found %s", ! &e->where, gfc_basic_typename (e->ts.type)); return FAILURE; } *************** gfc_specification_expr (gfc_expr *e) *** 2672,2683 **** /* Given two expressions, make sure that the arrays are conformable. */ ! try gfc_check_conformance (const char *optype_msgid, gfc_expr *op1, gfc_expr *op2) { int op1_flag, op2_flag, d; mpz_t op1_size, op2_size; ! try t; if (op1->rank == 0 || op2->rank == 0) return SUCCESS; --- 2767,2778 ---- /* Given two expressions, make sure that the arrays are conformable. */ ! gfc_try gfc_check_conformance (const char *optype_msgid, gfc_expr *op1, gfc_expr *op2) { int op1_flag, op2_flag, d; mpz_t op1_size, op2_size; ! gfc_try t; if (op1->rank == 0 || op2->rank == 0) return SUCCESS; *************** gfc_check_conformance (const char *optyp *** 2722,2728 **** /* Given an assignable expression and an arbitrary expression, make sure that the assignment can take place. */ ! try gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) { gfc_symbol *sym; --- 2817,2823 ---- /* Given an assignable expression and an arbitrary expression, make sure that the assignment can take place. */ ! gfc_try gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) { gfc_symbol *sym; *************** gfc_check_assign (gfc_expr *lvalue, gfc_ *** 2736,2742 **** has_pointer = sym->attr.pointer; for (ref = lvalue->ref; ref; ref = ref->next) ! if (ref->type == REF_COMPONENT && ref->u.c.component->pointer) { has_pointer = 1; break; --- 2831,2837 ---- has_pointer = sym->attr.pointer; for (ref = lvalue->ref; ref; ref = ref->next) ! if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer) { has_pointer = 1; break; *************** gfc_check_assign (gfc_expr *lvalue, gfc_ *** 2906,2918 **** if (lvalue->ts.type == BT_LOGICAL && rvalue->ts.type == BT_LOGICAL) return SUCCESS; ! gfc_error ("Incompatible types in assignment at %L, %s to %s", ! &lvalue->where, gfc_typename (&rvalue->ts), ! gfc_typename (&lvalue->ts)); return FAILURE; } return gfc_convert_type (rvalue, &lvalue->ts, 1); } --- 3001,3023 ---- if (lvalue->ts.type == BT_LOGICAL && rvalue->ts.type == BT_LOGICAL) return SUCCESS; ! gfc_error ("Incompatible types in DATA statement at %L; attempted " ! "conversion of %s to %s", &lvalue->where, ! gfc_typename (&rvalue->ts), gfc_typename (&lvalue->ts)); return FAILURE; } + /* Assignment is the only case where character variables of different + 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 SUCCESS; + } + return gfc_convert_type (rvalue, &lvalue->ts, 1); } *************** gfc_check_assign (gfc_expr *lvalue, gfc_ *** 2921,2927 **** we only check rvalue if it's not an assignment to NULL() or a NULLIFY statement. */ ! try gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) { symbol_attribute attr; --- 3026,3032 ---- we only check rvalue if it's not an assignment to NULL() or a NULLIFY statement. */ ! gfc_try gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) { symbol_attribute attr; *************** gfc_check_pointer_assign (gfc_expr *lval *** 2929,2935 **** int is_pure; int pointer, check_intent_in; ! if (lvalue->symtree->n.sym->ts.type == BT_UNKNOWN) { gfc_error ("Pointer assignment target is not a POINTER at %L", &lvalue->where); --- 3034,3041 ---- int is_pure; int pointer, check_intent_in; ! if (lvalue->symtree->n.sym->ts.type == BT_UNKNOWN ! && !lvalue->symtree->n.sym->attr.proc_pointer) { gfc_error ("Pointer assignment target is not a POINTER at %L", &lvalue->where); *************** gfc_check_pointer_assign (gfc_expr *lval *** 2937,2943 **** } if (lvalue->symtree->n.sym->attr.flavor == FL_PROCEDURE ! && lvalue->symtree->n.sym->attr.use_assoc) { gfc_error ("'%s' in the pointer assignment at %L cannot be an " "l-value since it is a procedure", --- 3043,3050 ---- } if (lvalue->symtree->n.sym->attr.flavor == FL_PROCEDURE ! && lvalue->symtree->n.sym->attr.use_assoc ! && !lvalue->symtree->n.sym->attr.proc_pointer) { gfc_error ("'%s' in the pointer assignment at %L cannot be an " "l-value since it is a procedure", *************** gfc_check_pointer_assign (gfc_expr *lval *** 2949,2962 **** /* Check INTENT(IN), unless the object itself is the component or sub-component of a pointer. */ check_intent_in = 1; ! pointer = lvalue->symtree->n.sym->attr.pointer; for (ref = lvalue->ref; ref; ref = ref->next) { if (pointer) check_intent_in = 0; ! if (ref->type == REF_COMPONENT && ref->u.c.component->pointer) pointer = 1; if (ref->type == REF_ARRAY && ref->next == NULL) --- 3056,3070 ---- /* Check INTENT(IN), unless the object itself is the component or sub-component of a pointer. */ check_intent_in = 1; ! pointer = lvalue->symtree->n.sym->attr.pointer ! | lvalue->symtree->n.sym->attr.proc_pointer; for (ref = lvalue->ref; ref; ref = ref->next) { if (pointer) check_intent_in = 0; ! if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer) pointer = 1; if (ref->type == REF_ARRAY && ref->next == NULL) *************** gfc_check_pointer_assign (gfc_expr *lval *** 3014,3023 **** if (rvalue->expr_type == EXPR_NULL && rvalue->ts.type == BT_UNKNOWN) return SUCCESS; if (!gfc_compare_types (&lvalue->ts, &rvalue->ts)) { ! gfc_error ("Different types in pointer assignment at %L", ! &lvalue->where); return FAILURE; } --- 3122,3164 ---- if (rvalue->expr_type == EXPR_NULL && rvalue->ts.type == BT_UNKNOWN) return SUCCESS; + /* Checks on rvalue for procedure pointer assignments. */ + if (lvalue->symtree->n.sym->attr.proc_pointer) + { + attr = gfc_expr_attr (rvalue); + if (!((rvalue->expr_type == EXPR_NULL) + || (rvalue->expr_type == EXPR_FUNCTION && attr.proc_pointer) + || (rvalue->expr_type == EXPR_VARIABLE + && attr.flavor == FL_PROCEDURE))) + { + gfc_error ("Invalid procedure pointer assignment at %L", + &rvalue->where); + return FAILURE; + } + if (attr.abstract) + { + gfc_error ("Abstract interface '%s' is invalid " + "in procedure pointer assignment at %L", + rvalue->symtree->name, &rvalue->where); + } + /* TODO. See PR 38290. + if (rvalue->expr_type == EXPR_VARIABLE + && lvalue->symtree->n.sym->attr.if_source != IFSRC_UNKNOWN + && !gfc_compare_interfaces (lvalue->symtree->n.sym, + rvalue->symtree->n.sym, 0)) + { + gfc_error ("Interfaces don't match " + "in procedure pointer assignment at %L", &rvalue->where); + return FAILURE; + }*/ + return SUCCESS; + } + if (!gfc_compare_types (&lvalue->ts, &rvalue->ts)) { ! gfc_error ("Different types in pointer assignment at %L; attempted " ! "assignment of %s to %s", &lvalue->where, ! gfc_typename (&rvalue->ts), gfc_typename (&lvalue->ts)); return FAILURE; } *************** gfc_check_pointer_assign (gfc_expr *lval *** 3039,3053 **** if (rvalue->expr_type == EXPR_NULL) return SUCCESS; ! if (lvalue->ts.type == BT_CHARACTER ! && lvalue->ts.cl && rvalue->ts.cl ! && lvalue->ts.cl->length && rvalue->ts.cl->length ! && abs (gfc_dep_compare_expr (lvalue->ts.cl->length, ! rvalue->ts.cl->length)) == 1) { ! gfc_error ("Different character lengths in pointer " ! "assignment at %L", &lvalue->where); ! return FAILURE; } if (rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue)) --- 3180,3190 ---- if (rvalue->expr_type == EXPR_NULL) return SUCCESS; ! if (lvalue->ts.type == BT_CHARACTER) { ! gfc_try t = gfc_check_same_strlen (lvalue, rvalue, "pointer assignment"); ! if (t == FAILURE) ! return FAILURE; } if (rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue)) *************** gfc_check_pointer_assign (gfc_expr *lval *** 3074,3080 **** return FAILURE; } ! if (attr.protected && attr.use_assoc && !attr.pointer) { gfc_error ("Pointer assignment target has PROTECTED " "attribute at %L", &rvalue->where); --- 3211,3218 ---- return FAILURE; } ! if (attr.is_protected && attr.use_assoc ! && !(attr.pointer || attr.proc_pointer)) { gfc_error ("Pointer assignment target has PROTECTED " "attribute at %L", &rvalue->where); *************** gfc_check_pointer_assign (gfc_expr *lval *** 3088,3098 **** /* Relative of gfc_check_assign() except that the lvalue is a single symbol. Used for initialization assignments. */ ! try gfc_check_assign_symbol (gfc_symbol *sym, gfc_expr *rvalue) { gfc_expr lvalue; ! try r; memset (&lvalue, '\0', sizeof (gfc_expr)); --- 3226,3236 ---- /* Relative of gfc_check_assign() except that the lvalue is a single symbol. Used for initialization assignments. */ ! gfc_try gfc_check_assign_symbol (gfc_symbol *sym, gfc_expr *rvalue) { gfc_expr lvalue; ! gfc_try r; memset (&lvalue, '\0', sizeof (gfc_expr)); *************** gfc_check_assign_symbol (gfc_symbol *sym *** 3104,3110 **** lvalue.symtree->n.sym = sym; lvalue.where = sym->declared_at; ! if (sym->attr.pointer) r = gfc_check_pointer_assign (&lvalue, rvalue); else r = gfc_check_assign (&lvalue, rvalue, 1); --- 3242,3248 ---- lvalue.symtree->n.sym = sym; lvalue.where = sym->declared_at; ! if (sym->attr.pointer || sym->attr.proc_pointer) r = gfc_check_pointer_assign (&lvalue, rvalue); else r = gfc_check_assign (&lvalue, rvalue, 1); *************** gfc_default_initializer (gfc_typespec *t *** 3126,3132 **** /* See if we have a default initializer. */ for (c = ts->derived->components; c; c = c->next) ! if (c->initializer || c->allocatable) break; if (!c) --- 3264,3270 ---- /* See if we have a default initializer. */ for (c = ts->derived->components; c; c = c->next) ! if (c->initializer || c->attr.allocatable) break; if (!c) *************** gfc_default_initializer (gfc_typespec *t *** 3152,3158 **** if (c->initializer) tail->expr = gfc_copy_expr (c->initializer); ! if (c->allocatable) { tail->expr = gfc_get_expr (); tail->expr->expr_type = EXPR_NULL; --- 3290,3296 ---- if (c->initializer) tail->expr = gfc_copy_expr (c->initializer); ! if (c->attr.allocatable) { tail->expr = gfc_get_expr (); tail->expr->expr_type = EXPR_NULL; *************** gfc_expr_set_symbols_referenced (gfc_exp *** 3336,3338 **** --- 3474,3569 ---- { gfc_traverse_expr (expr, NULL, expr_set_symbols_referenced, 0); } + + + /* Walk an expression tree and check each variable encountered for being typed. + If strict is not set, a top-level variable is tolerated untyped in -std=gnu + mode as is a basic arithmetic expression using those; this is for things in + legacy-code like: + + INTEGER :: arr(n), n + INTEGER :: arr(n + 1), n + + The namespace is needed for IMPLICIT typing. */ + + static gfc_namespace* check_typed_ns; + + static bool + expr_check_typed_help (gfc_expr* e, gfc_symbol* sym ATTRIBUTE_UNUSED, + int* f ATTRIBUTE_UNUSED) + { + gfc_try t; + + if (e->expr_type != EXPR_VARIABLE) + return false; + + gcc_assert (e->symtree); + t = gfc_check_symbol_typed (e->symtree->n.sym, check_typed_ns, + true, e->where); + + return (t == FAILURE); + } + + gfc_try + gfc_expr_check_typed (gfc_expr* e, gfc_namespace* ns, bool strict) + { + bool error_found; + + /* If this is a top-level variable or EXPR_OP, do the check with strict given + to us. */ + if (!strict) + { + if (e->expr_type == EXPR_VARIABLE && !e->ref) + return gfc_check_symbol_typed (e->symtree->n.sym, ns, strict, e->where); + + if (e->expr_type == EXPR_OP) + { + gfc_try t = SUCCESS; + + gcc_assert (e->value.op.op1); + t = gfc_expr_check_typed (e->value.op.op1, ns, strict); + + if (t == SUCCESS && e->value.op.op2) + t = gfc_expr_check_typed (e->value.op.op2, ns, strict); + + return t; + } + } + + /* Otherwise, walk the expression and do it strictly. */ + check_typed_ns = ns; + error_found = gfc_traverse_expr (e, NULL, &expr_check_typed_help, 0); + + return error_found ? FAILURE : SUCCESS; + } + + /* Walk an expression tree and replace all symbols with a corresponding symbol + in the formal_ns of "sym". Needed for copying interfaces in PROCEDURE + statements. The boolean return value is required by gfc_traverse_expr. */ + + static bool + replace_symbol (gfc_expr *expr, gfc_symbol *sym, int *i ATTRIBUTE_UNUSED) + { + if ((expr->expr_type == EXPR_VARIABLE + || (expr->expr_type == EXPR_FUNCTION + && !gfc_is_intrinsic (expr->symtree->n.sym, 0, expr->where))) + && expr->symtree->n.sym->ns == sym->ts.interface->formal_ns) + { + gfc_symtree *stree; + gfc_namespace *ns = sym->formal_ns; + /* Don't use gfc_get_symtree as we prefer to fail badly if we don't find + the symtree rather than create a new one (and probably fail later). */ + stree = gfc_find_symtree (ns ? ns->sym_root : gfc_current_ns->sym_root, + expr->symtree->n.sym->name); + gcc_assert (stree); + stree->n.sym->attr = expr->symtree->n.sym->attr; + expr->symtree = stree; + } + return false; + } + + void + gfc_expr_replace_symbols (gfc_expr *expr, gfc_symbol *dest) + { + gfc_traverse_expr (expr, dest, &replace_symbol, 0); + } diff -Nrcpad gcc-4.3.3/gcc/fortran/f95-lang.c gcc-4.4.0/gcc/fortran/f95-lang.c *** gcc-4.3.3/gcc/fortran/f95-lang.c Wed Apr 16 16:05:51 2008 --- gcc-4.4.0/gcc/fortran/f95-lang.c Tue Oct 7 18:15:32 2008 *************** along with GCC; see the file COPYING3. *** 29,35 **** #include "system.h" #include "coretypes.h" #include "tree.h" ! #include "tree-gimple.h" #include "flags.h" #include "langhooks.h" #include "langhooks-def.h" --- 29,35 ---- #include "system.h" #include "coretypes.h" #include "tree.h" ! #include "gimple.h" #include "flags.h" #include "langhooks.h" #include "langhooks-def.h" *************** along with GCC; see the file COPYING3. *** 45,50 **** --- 45,51 ---- #include "cgraph.h" #include "gfortran.h" + #include "cpp.h" #include "trans.h" #include "trans-types.h" #include "trans-const.h" *************** GTY(()) *** 61,67 **** union lang_tree_node GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"), ! chain_next ("(union lang_tree_node *)GENERIC_NEXT (&%h.generic)"))) { union tree_node GTY((tag ("0"), --- 62,68 ---- union lang_tree_node GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"), ! chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)"))) { union tree_node GTY((tag ("0"), *************** static void gfc_print_identifier (FILE * *** 95,104 **** static bool gfc_mark_addressable (tree); void do_function_end (void); int global_bindings_p (void); ! void insert_block (tree); ! static void gfc_clear_binding_stack (void); static void gfc_be_parse_file (int); static alias_set_type gfc_get_alias_set (tree); #undef LANG_HOOKS_NAME #undef LANG_HOOKS_INIT --- 96,105 ---- static bool gfc_mark_addressable (tree); void do_function_end (void); int global_bindings_p (void); ! static void clear_binding_stack (void); static void gfc_be_parse_file (int); static alias_set_type gfc_get_alias_set (tree); + static void gfc_init_ts (void); #undef LANG_HOOKS_NAME #undef LANG_HOOKS_INIT *************** static alias_set_type gfc_get_alias_set *** 111,129 **** #undef LANG_HOOKS_MARK_ADDRESSABLE #undef LANG_HOOKS_TYPE_FOR_MODE #undef LANG_HOOKS_TYPE_FOR_SIZE - #undef LANG_HOOKS_CLEAR_BINDING_STACK #undef LANG_HOOKS_GET_ALIAS_SET #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING #undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE #undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES #undef LANG_HOOKS_BUILTIN_FUNCTION #undef LANG_HOOKS_GET_ARRAY_DESCR_INFO /* Define lang hooks. */ ! #define LANG_HOOKS_NAME "GNU F95" #define LANG_HOOKS_INIT gfc_init #define LANG_HOOKS_FINISH gfc_finish #define LANG_HOOKS_INIT_OPTIONS gfc_init_options --- 112,134 ---- #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 #undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR + #undef LANG_HOOKS_OMP_CLAUSE_COPY_CTOR + #undef LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP + #undef LANG_HOOKS_OMP_CLAUSE_DTOR #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE + #undef LANG_HOOKS_OMP_PRIVATE_OUTER_REF #undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES #undef LANG_HOOKS_BUILTIN_FUNCTION #undef LANG_HOOKS_GET_ARRAY_DESCR_INFO /* Define lang hooks. */ ! #define LANG_HOOKS_NAME "GNU Fortran" #define LANG_HOOKS_INIT gfc_init #define LANG_HOOKS_FINISH gfc_finish #define LANG_HOOKS_INIT_OPTIONS gfc_init_options *************** static alias_set_type gfc_get_alias_set *** 131,146 **** #define LANG_HOOKS_POST_OPTIONS gfc_post_options #define LANG_HOOKS_PRINT_IDENTIFIER gfc_print_identifier #define LANG_HOOKS_PARSE_FILE gfc_be_parse_file ! #define LANG_HOOKS_MARK_ADDRESSABLE gfc_mark_addressable ! #define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode ! #define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size ! #define LANG_HOOKS_CLEAR_BINDING_STACK gfc_clear_binding_stack ! #define LANG_HOOKS_GET_ALIAS_SET gfc_get_alias_set #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference #define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR gfc_omp_clause_default_ctor #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_FIRSTPRIVATIZE_TYPE_SIZES \ gfc_omp_firstprivatize_type_sizes #define LANG_HOOKS_BUILTIN_FUNCTION gfc_builtin_function --- 136,155 ---- #define LANG_HOOKS_POST_OPTIONS gfc_post_options #define LANG_HOOKS_PRINT_IDENTIFIER gfc_print_identifier #define LANG_HOOKS_PARSE_FILE gfc_be_parse_file ! #define LANG_HOOKS_MARK_ADDRESSABLE gfc_mark_addressable ! #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 #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR gfc_omp_clause_default_ctor + #define LANG_HOOKS_OMP_CLAUSE_COPY_CTOR gfc_omp_clause_copy_ctor + #define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP gfc_omp_clause_assign_op + #define LANG_HOOKS_OMP_CLAUSE_DTOR gfc_omp_clause_dtor #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 #define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \ gfc_omp_firstprivatize_type_sizes #define LANG_HOOKS_BUILTIN_FUNCTION gfc_builtin_function *************** static alias_set_type gfc_get_alias_set *** 148,187 **** const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; - /* A list (chain of TREE_LIST nodes) of all LABEL_DECLs in the function - that have names. Here so we can clear out their names' definitions - at the end of the function. */ - - /* Tree code classes. */ - - #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE, - - const enum tree_code_class tree_code_type[] = { - #include "tree.def" - }; - #undef DEFTREECODE - - /* Table indexed by tree code giving number of expression - operands beyond the fixed part of the node structure. - Not used for types or decls. */ - - #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH, - - const unsigned char tree_code_length[] = { - #include "tree.def" - }; - #undef DEFTREECODE - - /* Names of tree components. - Used for printing out the tree and error messages. */ - #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME, - - const char *const tree_code_name[] = { - #include "tree.def" - }; - #undef DEFTREECODE - - #define NULL_BINDING_LEVEL (struct binding_level *) NULL /* A chain of binding_level structures awaiting reuse. */ --- 157,162 ---- *************** gfc_truthvalue_conversion (tree expr) *** 220,235 **** return expr; } else if (TREE_CODE (expr) == NOP_EXPR) ! return build1 (NOP_EXPR, boolean_type_node, TREE_OPERAND (expr, 0)); else ! return build1 (NOP_EXPR, boolean_type_node, expr); case INTEGER_TYPE: if (TREE_CODE (expr) == INTEGER_CST) return integer_zerop (expr) ? boolean_false_node : boolean_true_node; else ! return build2 (NE_EXPR, boolean_type_node, expr, ! build_int_cst (TREE_TYPE (expr), 0)); default: internal_error ("Unexpected type in truthvalue_conversion"); --- 195,211 ---- return expr; } else if (TREE_CODE (expr) == NOP_EXPR) ! return fold_build1 (NOP_EXPR, ! boolean_type_node, TREE_OPERAND (expr, 0)); else ! return fold_build1 (NOP_EXPR, boolean_type_node, expr); case INTEGER_TYPE: if (TREE_CODE (expr) == INTEGER_CST) return integer_zerop (expr) ? boolean_false_node : boolean_true_node; else ! return fold_build2 (NE_EXPR, boolean_type_node, expr, ! build_int_cst (TREE_TYPE (expr), 0)); default: internal_error ("Unexpected type in truthvalue_conversion"); *************** gfc_be_parse_file (int set_yydebug ATTRI *** 263,272 **** cgraph_finalize_compilation_unit (); cgraph_optimize (); ! /* Tell the frontent about any errors. */ gfc_get_errors (&warnings, &errors); errorcount += errors; warningcount += warnings; } --- 239,250 ---- cgraph_finalize_compilation_unit (); cgraph_optimize (); ! /* Tell the frontend about any errors. */ gfc_get_errors (&warnings, &errors); errorcount += errors; warningcount += warnings; + + clear_binding_stack (); } *************** gfc_be_parse_file (int set_yydebug ATTRI *** 275,294 **** static bool gfc_init (void) { ! #ifdef USE_MAPPED_LOCATION ! linemap_add (line_table, LC_ENTER, false, gfc_source_file, 1); ! linemap_add (line_table, LC_RENAME, false, "", 0); ! #endif - /* First initialize the backend. */ gfc_init_decl_processing (); gfc_static_ctors = NULL_TREE; ! /* Then the frontend. */ gfc_init_1 (); if (gfc_new_file () != SUCCESS) fatal_error ("can't open input file: %s", gfc_source_file); return true; } --- 253,277 ---- static bool gfc_init (void) { ! if (!gfc_cpp_enabled ()) ! { ! linemap_add (line_table, LC_ENTER, false, gfc_source_file, 1); ! linemap_add (line_table, LC_RENAME, false, "", 0); ! } ! else ! gfc_cpp_init_0 (); gfc_init_decl_processing (); gfc_static_ctors = NULL_TREE; ! if (gfc_cpp_enabled ()) ! gfc_cpp_init (); ! gfc_init_1 (); if (gfc_new_file () != SUCCESS) fatal_error ("can't open input file: %s", gfc_source_file); + return true; } *************** gfc_init (void) *** 296,301 **** --- 279,285 ---- static void gfc_finish (void) { + gfc_cpp_done (); gfc_done_1 (); gfc_release_include_path (); return; *************** poplevel (int keep, int reverse, int fun *** 446,459 **** current_binding_level = current_binding_level->level_chain; if (functionbody) ! { ! /* This is the top level block of a function. The ..._DECL chain stored ! in BLOCK_VARS are the function's parameters (PARM_DECL nodes). Don't ! leave them in the BLOCK because they are found in the FUNCTION_DECL ! instead. */ ! DECL_INITIAL (current_function_decl) = block_node; ! BLOCK_VARS (block_node) = 0; ! } else if (block_node) { current_binding_level->blocks --- 430,441 ---- current_binding_level = current_binding_level->level_chain; if (functionbody) ! /* This is the top level block of a function. */ ! DECL_INITIAL (current_function_decl) = block_node; ! else if (current_binding_level == global_binding_level) ! /* When using gfc_start_block/gfc_finish_block from middle-end hooks, ! don't add newly created BLOCKs as subblocks of global_binding_level. */ ! ; else if (block_node) { current_binding_level->blocks *************** poplevel (int keep, int reverse, int fun *** 474,492 **** } - /* Insert BLOCK at the end of the list of subblocks of the - current binding level. This is used when a BIND_EXPR is expanded, - to handle the BLOCK node inside the BIND_EXPR. */ - - void - insert_block (tree block) - { - TREE_USED (block) = 1; - current_binding_level->blocks - = chainon (current_binding_level->blocks, block); - } - - /* Records a ..._DECL node DECL as belonging to the current lexical scope. Returns the ..._DECL node. */ --- 456,461 ---- *************** pushdecl_top_level (tree x) *** 537,543 **** /* Clear the binding stack. */ static void ! gfc_clear_binding_stack (void) { while (!global_bindings_p ()) poplevel (0, 0, 0); --- 506,512 ---- /* Clear the binding stack. */ static void ! clear_binding_stack (void) { while (!global_bindings_p ()) poplevel (0, 0, 0); *************** gfc_init_decl_processing (void) *** 575,586 **** only use it for actual characters, not for INTEGER(1). Also, we want double_type_node to actually have double precision. */ build_common_tree_nodes (false, false); ! /* x86_64 minw32 has a sizetype of "unsigned long long", most other hosts have a sizetype of "unsigned long". Therefore choose the correct size in mostly target independent way. */ ! if (TYPE_MODE (long_unsigned_type_node) == Pmode) set_sizetype (long_unsigned_type_node); ! else if (TYPE_MODE (long_long_unsigned_type_node) == Pmode) set_sizetype (long_long_unsigned_type_node); else set_sizetype (long_unsigned_type_node); --- 544,555 ---- only use it for actual characters, not for INTEGER(1). Also, we want double_type_node to actually have double precision. */ build_common_tree_nodes (false, false); ! /* x86_64 mingw32 has a sizetype of "unsigned long long", most other hosts have a sizetype of "unsigned long". Therefore choose the correct size in mostly target independent way. */ ! if (TYPE_MODE (long_unsigned_type_node) == ptr_mode) set_sizetype (long_unsigned_type_node); ! else if (TYPE_MODE (long_long_unsigned_type_node) == ptr_mode) set_sizetype (long_long_unsigned_type_node); else set_sizetype (long_unsigned_type_node); *************** gfc_mark_addressable (tree exp) *** 632,638 **** IDENTIFIER_POINTER (DECL_NAME (x))); return false; } ! pedwarn ("register variable %qs used in nested function", IDENTIFIER_POINTER (DECL_NAME (x))); } else if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x)) --- 601,607 ---- IDENTIFIER_POINTER (DECL_NAME (x))); return false; } ! pedwarn (input_location, 0, "register variable %qs used in nested function", IDENTIFIER_POINTER (DECL_NAME (x))); } else if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x)) *************** gfc_mark_addressable (tree exp) *** 657,663 **** } #endif ! pedwarn ("address of register variable %qs requested", IDENTIFIER_POINTER (DECL_NAME (x))); } --- 626,632 ---- } #endif ! pedwarn (input_location, 0, "address of register variable %qs requested", IDENTIFIER_POINTER (DECL_NAME (x))); } *************** build_builtin_fntypes (tree *fntype, tre *** 757,762 **** --- 726,741 ---- tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node); tmp = tree_cons (NULL_TREE, type, tmp); fntype[2] = build_function_type (type, tmp); + /* type (*) (void) */ + fntype[3] = build_function_type (type, void_list_node); + /* type (*) (type, &int) */ + tmp = tree_cons (NULL_TREE, type, void_list_node); + tmp = tree_cons (NULL_TREE, build_pointer_type (integer_type_node), tmp); + fntype[4] = build_function_type (type, tmp); + /* type (*) (type, int) */ + tmp = tree_cons (NULL_TREE, type, void_list_node); + tmp = tree_cons (NULL_TREE, integer_type_node, tmp); + fntype[5] = build_function_type (type, tmp); } *************** gfc_init_builtin_functions (void) *** 807,818 **** ATTR_CONST_NOTHROW_LIST }; ! tree mfunc_float[3]; ! tree mfunc_double[3]; ! tree mfunc_longdouble[3]; ! tree mfunc_cfloat[3]; ! tree mfunc_cdouble[3]; ! tree mfunc_clongdouble[3]; tree func_cfloat_float, func_float_cfloat; tree func_cdouble_double, func_double_cdouble; tree func_clongdouble_longdouble, func_longdouble_clongdouble; --- 786,797 ---- ATTR_CONST_NOTHROW_LIST }; ! tree mfunc_float[6]; ! tree mfunc_double[6]; ! tree mfunc_longdouble[6]; ! tree mfunc_cfloat[6]; ! tree mfunc_cdouble[6]; ! tree mfunc_clongdouble[6]; tree func_cfloat_float, func_float_cfloat; tree func_cdouble_double, func_double_cdouble; tree func_clongdouble_longdouble, func_longdouble_clongdouble; *************** gfc_init_builtin_functions (void) *** 903,908 **** --- 882,915 ---- gfc_define_builtin ("__builtin_copysignf", mfunc_float[1], BUILT_IN_COPYSIGNF, "copysignf", true); + gfc_define_builtin ("__builtin_nextafterl", mfunc_longdouble[1], + BUILT_IN_NEXTAFTERL, "nextafterl", true); + gfc_define_builtin ("__builtin_nextafter", mfunc_double[1], + BUILT_IN_NEXTAFTER, "nextafter", true); + gfc_define_builtin ("__builtin_nextafterf", mfunc_float[1], + BUILT_IN_NEXTAFTERF, "nextafterf", true); + + gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4], + BUILT_IN_FREXPL, "frexpl", false); + gfc_define_builtin ("__builtin_frexp", mfunc_double[4], + BUILT_IN_FREXP, "frexp", false); + gfc_define_builtin ("__builtin_frexpf", mfunc_float[4], + BUILT_IN_FREXPF, "frexpf", false); + + gfc_define_builtin ("__builtin_fabsl", mfunc_longdouble[0], + BUILT_IN_FABSL, "fabsl", true); + gfc_define_builtin ("__builtin_fabs", mfunc_double[0], + BUILT_IN_FABS, "fabs", true); + gfc_define_builtin ("__builtin_fabsf", mfunc_float[0], + BUILT_IN_FABSF, "fabsf", true); + + gfc_define_builtin ("__builtin_scalbnl", mfunc_longdouble[5], + BUILT_IN_SCALBNL, "scalbnl", true); + gfc_define_builtin ("__builtin_scalbn", mfunc_double[5], + BUILT_IN_SCALBN, "scalbn", true); + gfc_define_builtin ("__builtin_scalbnf", mfunc_float[5], + BUILT_IN_SCALBNF, "scalbnf", true); + gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1], BUILT_IN_FMODL, "fmodl", true); gfc_define_builtin ("__builtin_fmod", mfunc_double[1], *************** gfc_init_builtin_functions (void) *** 910,915 **** --- 917,929 ---- gfc_define_builtin ("__builtin_fmodf", mfunc_float[1], BUILT_IN_FMODF, "fmodf", true); + gfc_define_builtin ("__builtin_infl", mfunc_longdouble[3], + BUILT_IN_INFL, "__builtin_infl", true); + gfc_define_builtin ("__builtin_inf", mfunc_double[3], + BUILT_IN_INF, "__builtin_inf", true); + gfc_define_builtin ("__builtin_inff", mfunc_float[3], + BUILT_IN_INFF, "__builtin_inff", true); + /* lround{f,,l} and llround{f,,l} */ type = tree_cons (NULL_TREE, float_type_node, void_list_node); tmp = build_function_type (long_integer_type_node, type); *************** gfc_init_builtin_functions (void) *** 983,988 **** --- 997,1033 ---- BUILT_IN_SINCOSF, "sincosf", false); } + /* For LEADZ / TRAILZ. */ + tmp = tree_cons (NULL_TREE, unsigned_type_node, void_list_node); + ftype = build_function_type (integer_type_node, tmp); + gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ, + "__builtin_clz", true); + + tmp = tree_cons (NULL_TREE, long_unsigned_type_node, void_list_node); + ftype = build_function_type (integer_type_node, tmp); + gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL, + "__builtin_clzl", true); + + tmp = tree_cons (NULL_TREE, long_long_unsigned_type_node, void_list_node); + ftype = build_function_type (integer_type_node, tmp); + gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL, + "__builtin_clzll", true); + + tmp = tree_cons (NULL_TREE, unsigned_type_node, void_list_node); + ftype = build_function_type (integer_type_node, tmp); + gfc_define_builtin ("__builtin_ctz", ftype, BUILT_IN_CTZ, + "__builtin_ctz", true); + + tmp = tree_cons (NULL_TREE, long_unsigned_type_node, void_list_node); + ftype = build_function_type (integer_type_node, tmp); + gfc_define_builtin ("__builtin_ctzl", ftype, BUILT_IN_CTZL, + "__builtin_ctzl", true); + + tmp = tree_cons (NULL_TREE, long_long_unsigned_type_node, void_list_node); + ftype = build_function_type (integer_type_node, tmp); + gfc_define_builtin ("__builtin_ctzll", ftype, BUILT_IN_CTZLL, + "__builtin_ctzll", true); + /* Other builtin functions we use. */ tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node); *************** gfc_init_builtin_functions (void) *** 1172,1176 **** --- 1217,1231 ---- #undef DEFINE_MATH_BUILTIN_C #undef DEFINE_MATH_BUILTIN + static void + gfc_init_ts (void) + { + tree_contains_struct[NAMESPACE_DECL][TS_DECL_NON_COMMON] = 1; + tree_contains_struct[NAMESPACE_DECL][TS_DECL_WITH_VIS] = 1; + tree_contains_struct[NAMESPACE_DECL][TS_DECL_WRTL] = 1; + tree_contains_struct[NAMESPACE_DECL][TS_DECL_COMMON] = 1; + tree_contains_struct[NAMESPACE_DECL][TS_DECL_MINIMAL] = 1; + } + #include "gt-fortran-f95-lang.h" #include "gtype-fortran.h" diff -Nrcpad gcc-4.3.3/gcc/fortran/gfc-internals.texi gcc-4.4.0/gcc/fortran/gfc-internals.texi *** gcc-4.3.3/gcc/fortran/gfc-internals.texi Sun Apr 15 14:28:43 2007 --- gcc-4.4.0/gcc/fortran/gfc-internals.texi Mon Sep 1 10:55:50 2008 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @c %**start of header @setfilename gfc-internals.info ! @set copyrights-gfortran 2007 @include gcc-common.texi --- 1,7 ---- \input texinfo @c -*-texinfo-*- @c %**start of header @setfilename gfc-internals.info ! @set copyrights-gfortran 2007-2008 @include gcc-common.texi *************** *** 34,44 **** Copyright @copyright{} @value{copyrights-gfortran} 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.1 or any later version published by the Free Software Foundation; with the ! Invariant Sections being ``GNU General Public License'' and ``Funding ! Free Software'', the Front-Cover ! texts being (a) (see below), and with the Back-Cover Texts being (b) (see below). A copy of the license is included in the section entitled ``GNU Free Documentation License''. --- 34,43 ---- Copyright @copyright{} @value{copyrights-gfortran} 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.2 or any later version published by the Free Software Foundation; with the ! Invariant Sections being ``Funding Free Software'', the Front-Cover ! Texts being (a) (see below), and with the Back-Cover Texts being (b) (see below). A copy of the license is included in the section entitled ``GNU Free Documentation License''. *************** not accurately reflect the status of the *** 119,127 **** * User Interface:: Code that Interacts with the User. * Frontend Data Structures:: Data structures used by the frontend * LibGFortran:: The LibGFortran Runtime Library. * GNU Free Documentation License:: ! How you can copy and share this manual. * Index:: Index of this documentation. @end menu @end ifnottex --- 118,127 ---- * User Interface:: Code that Interacts with the User. * Frontend Data Structures:: Data structures used by the frontend + * Object Orientation:: Internals of Fortran 2003 OOP features. * LibGFortran:: The LibGFortran Runtime Library. * GNU Free Documentation License:: ! How you can copy and share this manual. * Index:: Index of this documentation. @end menu @end ifnottex *************** should exhaust all possible valid combin *** 284,292 **** structures. @menu ! * gfc_code:: Representation of Executable Statements @end menu @node gfc_code @section @code{gfc_code} @cindex statement chaining --- 284,297 ---- structures. @menu ! * gfc_code:: Representation of Executable Statements. ! * gfc_expr:: Representation of Values and Expressions. @end menu + + @c gfc_code + @c -------- + @node gfc_code @section @code{gfc_code} @cindex statement chaining *************** last in a block, @code{here} points to t *** 307,321 **** current statement. If the current statement is one of @code{IF}, @code{DO}, @code{SELECT} ! it starts a block, i.e. a nested level in the program. In order to represent this, the @code{block} member is set to point to a ! @code{gfc_code} structure whose @code{block} member points to the ! block in question. The @code{SELECT} and @code{IF} statements may ! contain various blocks (the chain of @code{ELSE IF} and @code{ELSE} ! blocks or the various @code{CASE}s, respectively). ! @c What would be nice here would be an example program together with ! @c an image that says more than the mythical thousand words. @c --------------------------------------------------------------------- --- 312,652 ---- current statement. If the current statement is one of @code{IF}, @code{DO}, @code{SELECT} ! it starts a block, i.e.@: a nested level in the program. In order to represent this, the @code{block} member is set to point to a ! @code{gfc_code} structure whose @code{next} member starts the chain of ! statements inside the block; this structure's @code{op} member should be set to ! the same value as the parent structure's @code{op} member. The @code{SELECT} ! and @code{IF} statements may contain various blocks (the chain of @code{ELSE IF} ! and @code{ELSE} blocks or the various @code{CASE}s, respectively). These chains ! are linked-lists formed by the @code{block} members. ! Consider the following example code: ! ! @example ! IF (foo < 20) THEN ! PRINT *, "Too small" ! foo = 20 ! ELSEIF (foo > 50) THEN ! PRINT *, "Too large" ! foo = 50 ! ELSE ! PRINT *, "Good" ! END IF ! @end example ! ! This statement-block will be represented in the internal gfortran tree as ! follows, were the horizontal link-chains are those induced by the @code{next} ! members and vertical links down are those of @code{block}. @samp{==|} and ! @samp{--|} mean @code{NULL} pointers to mark the end of a chain: ! ! @example ! ... ==> IF ==> ... ! | ! +--> IF foo < 20 ==> PRINT *, "Too small" ==> foo = 20 ==| ! | ! +--> IF foo > 50 ==> PRINT *, "Too large" ==> foo = 50 ==| ! | ! +--> ELSE ==> PRINT *, "Good" ==| ! | ! +--| ! @end example ! ! ! @subsection IF Blocks ! ! Conditionals are represented by @code{gfc_code} structures with their ! @code{op} member set to @code{EXEC_IF}. This structure's @code{block} ! member must point to another @code{gfc_code} node that is the header of the ! if-block. This header's @code{op} member must be set to @code{EXEC_IF}, too, ! its @code{expr} member holds the condition to check for, and its @code{next} ! should point to the code-chain of the statements to execute if the condition is ! true. ! ! If in addition an @code{ELSEIF} or @code{ELSE} block is present, the ! @code{block} member of the if-block-header node points to yet another ! @code{gfc_code} structure that is the header of the elseif- or else-block. Its ! structure is identical to that of the if-block-header, except that in case of an ! @code{ELSE} block without a new condition the @code{expr} member should be ! @code{NULL}. This block can itself have its @code{block} member point to the ! next @code{ELSEIF} or @code{ELSE} block if there's a chain of them. ! ! ! @subsection Loops ! ! @code{DO} loops are stored in the tree as @code{gfc_code} nodes with their ! @code{op} set to @code{EXEC_DO} for a @code{DO} loop with iterator variable and ! to @code{EXEC_DO_WHILE} for infinite @code{DO}s and @code{DO WHILE} blocks. ! Their @code{block} member should point to a @code{gfc_code} structure heading ! the code-chain of the loop body; its @code{op} member should be set to ! @code{EXEC_DO} or @code{EXEC_DO_WHILE}, too, respectively. ! ! For @code{DO WHILE} loops, the loop condition is stored on the top ! @code{gfc_code} structure's @code{expr} member; @code{DO} forever loops are ! simply @code{DO WHILE} loops with a constant @code{.TRUE.} loop condition in ! the internal representation. ! ! Similarly, @code{DO} loops with an iterator have instead of the condition their ! @code{ext.iterator} member set to the correct values for the loop iterator ! variable and its range. ! ! ! @subsection @code{SELECT} Statements ! ! A @code{SELECT} block is introduced by a @code{gfc_code} structure with an ! @code{op} member of @code{EXEC_SELECT} and @code{expr} containing the expression ! to evaluate and test. Its @code{block} member starts a list of @code{gfc_code} ! structures linked together by their @code{block} members that stores the various ! @code{CASE} parts. ! ! Each @code{CASE} node has its @code{op} member set to @code{EXEC_SELECT}, too, ! its @code{next} member points to the code-chain to be executed in the current ! case-block, and @code{extx.case_list} contains the case-values this block ! corresponds to. The @code{block} member links to the next case in the list. ! ! ! @c gfc_expr ! @c -------- ! ! @node gfc_expr ! @section @code{gfc_expr} ! @tindex @code{gfc_expr} ! @tindex @code{struct gfc_expr} ! ! Expressions and ``values'', including constants, variable-, array- and ! component-references as well as complex expressions consisting of operators and ! function calls are internally represented as one or a whole tree of ! @code{gfc_expr} objects. The member @code{expr_type} specifies the overall ! type of an expression (for instance, @code{EXPR_CONSTANT} for constants or ! @code{EXPR_VARIABLE} for variable references). The members @code{ts} and ! @code{rank} as well as @code{shape}, which can be @code{NULL}, specify ! the type, rank and, if applicable, shape of the whole expression or expression ! tree of which the current structure is the root. @code{where} is the locus of ! this expression in the source code. ! ! Depending on the flavour of the expression being described by the object ! (that is, the value of its @code{expr_type} member), the corresponding structure ! in the @code{value} union will usually contain additional data describing the ! expression's value in a type-specific manner. The @code{ref} member is used to ! build chains of (array-, component- and substring-) references if the expression ! in question contains such references, see below for details. ! ! ! @subsection Constants ! ! Scalar constants are represented by @code{gfc_expr} nodes with their ! @code{expr_type} set to @code{EXPR_CONSTANT}. The constant's value shall ! already be known at compile-time and is stored in the @code{logical}, ! @code{integer}, @code{real}, @code{complex} or @code{character} struct inside ! @code{value}, depending on the constant's type specification. ! ! ! @subsection Operators ! ! Operator-expressions are expressions that are the result of the execution of ! some operator on one or two operands. The expressions have an @code{expr_type} ! of @code{EXPR_OP}. Their @code{value.op} structure contains additional data. ! ! @code{op1} and optionally @code{op2} if the operator is binary point to the ! two operands, and @code{operator} or @code{uop} describe the operator that ! should be evaluated on these operands, where @code{uop} describes a user-defined ! operator. ! ! ! @subsection Function Calls ! ! If the expression is the return value of a function-call, its @code{expr_type} ! is set to @code{EXPR_FUNCTION}, and @code{symtree} must point to the symtree ! identifying the function to be called. @code{value.function.actual} holds the ! actual arguments given to the function as a linked list of ! @code{gfc_actual_arglist} nodes. ! ! The other members of @code{value.function} describe the function being called ! in more detail, containing a link to the intrinsic symbol or user-defined ! function symbol if the call is to an intrinsic or external function, ! respectively. These values are determined during resolution-phase from the ! structure's @code{symtree} member. ! ! A special case of function calls are ``component calls'' to type-bound ! procedures; those have the @code{expr_type} @code{EXPR_COMPCALL} with ! @code{value.compcall} containing the argument list and the procedure called, ! while @code{symtree} and @code{ref} describe the object on which the procedure ! was called in the same way as a @code{EXPR_VARIABLE} expression would. ! @xref{Type-bound Procedures}. ! ! ! @subsection Array- and Structure-Constructors ! ! Array- and structure-constructors (one could probably call them ``array-'' and ! ``derived-type constants'') are @code{gfc_expr} structures with their ! @code{expr_type} member set to @code{EXPR_ARRAY} or @code{EXPR_STRUCTURE}, ! respectively. For structure constructors, @code{symtree} points to the ! derived-type symbol for the type being constructed. ! ! The values for initializing each array element or structure component are ! stored as linked-list of @code{gfc_constructor} nodes in the ! @code{value.constructor} member. ! ! ! @subsection Null ! ! @code{NULL} is a special value for pointers; it can be of different base types. ! Such a @code{NULL} value is represented in the internal tree by a ! @code{gfc_expr} node with @code{expr_type} @code{EXPR_NULL}. If the base type ! of the @code{NULL} expression is known, it is stored in @code{ts} (that's for ! instance the case for default-initializers of @code{ALLOCATABLE} components), ! but this member can also be set to @code{BT_UNKNOWN} if the information is not ! available (for instance, when the expression is a pointer-initializer ! @code{NULL()}). ! ! ! @subsection Variables and Reference Expressions ! ! Variable references are @code{gfc_expr} structures with their @code{expr_type} ! set to @code{EXPR_VARIABLE}; their @code{symtree} should point to the variable ! that is referenced. ! ! For this type of expression, it's also possible to chain array-, component- ! or substring-references to the original expression to get something like ! @samp{struct%component(2:5)}, where @code{component} is either an array or ! a @code{CHARACTER} member of @code{struct} that is of some derived-type. Such a ! chain of references is achieved by a linked list headed by @code{ref} of the ! @code{gfc_expr} node. For the example above it would be (@samp{==|} is the ! last @code{NULL} pointer): ! ! @smallexample ! EXPR_VARIABLE(struct) ==> REF_COMPONENT(component) ==> REF_ARRAY(2:5) ==| ! @end smallexample ! ! If @code{component} is a string rather than an array, the last element would be ! a @code{REF_SUBSTRING} reference, of course. If the variable itself or some ! component referenced is an array and the expression should reference the whole ! array rather than being followed by an array-element or -section reference, a ! @code{REF_ARRAY} reference must be built as the last element in the chain with ! an array-reference type of @code{AR_FULL}. Consider this example code: ! ! @smallexample ! TYPE :: mytype ! INTEGER :: array(42) ! END TYPE mytype ! ! TYPE(mytype) :: variable ! INTEGER :: local_array(5) ! ! CALL do_something (variable%array, local_array) ! @end smallexample ! ! The @code{gfc_expr} nodes representing the arguments to the @samp{do_something} ! call will have a reference-chain like this: ! ! @smallexample ! EXPR_VARIABLE(variable) ==> REF_COMPONENT(array) ==> REF_ARRAY(FULL) ==| ! EXPR_VARIABLE(local_array) ==> REF_ARRAY(FULL) ==| ! @end smallexample ! ! ! @subsection Constant Substring References ! ! @code{EXPR_SUBSTRING} is a special type of expression that encodes a substring ! reference of a constant string, as in the following code snippet: ! ! @smallexample ! x = "abcde"(1:2) ! @end smallexample ! ! In this case, @code{value.character} contains the full string's data as if it ! was a string constant, but the @code{ref} member is also set and points to a ! substring reference as described in the subsection above. ! ! ! @c --------------------------------------------------------------------- ! @c F2003 OOP ! @c --------------------------------------------------------------------- ! ! @node Object Orientation ! @chapter Internals of Fortran 2003 OOP Features ! ! @menu ! * Type-bound Procedures:: Type-bound procedures. ! @end menu ! ! ! @c Type-bound procedures ! @c --------------------- ! ! @node Type-bound Procedures ! @section Type-bound Procedures ! ! Type-bound procedures are stored in the @code{sym_root} of the namespace ! @code{f2k_derived} associated with the derived-type symbol as @code{gfc_symtree} ! nodes. The name and symbol of these symtrees corresponds to the binding-name ! of the procedure, i.e. the name that is used to call it from the context of an ! object of the derived-type. ! ! In addition, those and only those symtrees representing a type-bound procedure ! have their @code{typebound} member set; @code{typebound} points to a struct of ! type @code{gfc_typebound_proc} containing the additional data needed: The ! binding attributes (like @code{PASS} and @code{NOPASS}, @code{NON_OVERRIDABLE} ! or the access-specifier), the binding's target(s) and, if the current binding ! overrides or extends an inherited binding of the same name, @code{overridden} ! points to this binding's @code{gfc_typebound_proc} structure. ! ! ! @subsection Specific Bindings ! @c -------------------------- ! ! For specific bindings (declared with @code{PROCEDURE}), if they have a ! passed-object argument, the passed-object dummy argument is first saved by its ! name, and later during resolution phase the corresponding argument is looked for ! and its position remembered as @code{pass_arg_num} in @code{gfc_typebound_proc}. ! The binding's target procedure is pointed-to by @code{u.specific}. ! ! At the moment, all type-bound procedure calls are statically dispatched and ! transformed into ordinary procedure calls at resolution time; their actual ! argument list is updated to include at the right position the passed-object ! argument, if applicable, and then a simple procedure call to the binding's ! target procedure is built. To handle dynamic dispatch in the future, this will ! be extended to allow special code generation during the trans-phase to dispatch ! based on the object's dynamic type. ! ! ! @subsection Generic Bindings ! @c ------------------------- ! ! Bindings declared as @code{GENERIC} store the specific bindings they target as ! a linked list using nodes of type @code{gfc_tbp_generic} in @code{u.generic}. ! For each specific target, the parser records its symtree and during resolution ! this symtree is bound to the corresponding @code{gfc_typebound_proc} structure ! of the specific target. ! ! Calls to generic bindings are handled entirely in the resolution-phase, where ! for the actual argument list present the matching specific binding is found ! and the call's target procedure (@code{value.compcall.tbp}) is re-pointed to ! the found specific binding and this call is subsequently handled by the logic ! for specific binding calls. ! ! ! @subsection Calls to Type-bound Procedures ! @c --------------------------------------- ! ! Calls to type-bound procedures are stored in the parse-tree as @code{gfc_expr} ! nodes of type @code{EXPR_COMPCALL}. Their @code{value.compcall.actual} saves ! the actual argument list of the call and @code{value.compcall.tbp} points to the ! @code{gfc_typebound_proc} structure of the binding to be called. The object ! in whose context the procedure was called is saved by combination of ! @code{symtree} and @code{ref}, as if the expression was of type ! @code{EXPR_VARIABLE}. ! ! For code like this: ! @smallexample ! CALL myobj%procedure (arg1, arg2) ! @end smallexample ! @noindent ! the @code{CALL} is represented in the parse-tree as a @code{gfc_code} node of ! type @code{EXEC_COMPCALL}. The @code{expr} member of this node holds an ! expression of type @code{EXPR_COMPCALL} of the same structure as mentioned above ! except that its target procedure is of course a @code{SUBROUTINE} and not a ! @code{FUNCTION}. @c --------------------------------------------------------------------- *************** Versioning - Ulrich Depper} *** 359,371 **** @item @uref{http://people.redhat.com/drepper/dsohowto.pdf, How to Write Shared ! Libraries - Ulrich Depper (see Chapter 3)} @end itemize If one adds a new symbol to a library that should be exported, the new symbol should be mentioned in the map file and a new version node ! defined, e.g. if one adds a new symbols @code{foo} and @code{bar} to libgfortran for the next GCC release, the following should be added to the map file: @smallexample --- 690,702 ---- @item @uref{http://people.redhat.com/drepper/dsohowto.pdf, How to Write Shared ! Libraries - Ulrich Drepper (see Chapter 3)} @end itemize If one adds a new symbol to a library that should be exported, the new symbol should be mentioned in the map file and a new version node ! defined, e.g., if one adds a new symbols @code{foo} and @code{bar} to libgfortran for the next GCC release, the following should be added to the map file: @smallexample diff -Nrcpad gcc-4.3.3/gcc/fortran/gfortran.h gcc-4.4.0/gcc/fortran/gfortran.h *** gcc-4.3.3/gcc/fortran/gfortran.h Sat Jan 10 21:01:14 2009 --- gcc-4.4.0/gcc/fortran/gfortran.h Sat Feb 21 22:25:06 2009 *************** *** 1,5 **** /* gfortran header file ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* gfortran header file ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught *************** char *alloca (); *** 78,84 **** #define stringize(x) expand_macro(x) #define expand_macro(x) # x ! /* For a the runtime library, a standard prefix is a requirement to avoid cluttering the namespace with things nobody asked for. It's ugly to look at and a pain to type when you add the prefix by hand, so we hide it behind a macro. */ --- 78,84 ---- #define stringize(x) expand_macro(x) #define expand_macro(x) # x ! /* For the runtime library, a standard prefix is a requirement to avoid cluttering the namespace with things nobody asked for. It's ugly to look at and a pain to type when you add the prefix by hand, so we hide it behind a macro. */ *************** mstring; *** 103,108 **** --- 103,114 ---- /*************************** Enums *****************************/ + /* Used when matching and resolving data I/O transfer statements. */ + + typedef enum + { M_READ, M_WRITE, M_PRINT, M_INQUIRE } + io_kind; + /* The author remains confused to this day about the convention of returning '0' for 'SUCCESS'... or was it the other way around? The following enum makes things much more readable. We also start *************** mstring; *** 110,116 **** typedef enum { SUCCESS = 1, FAILURE } ! try; /* This is returned by gfc_notification_std to know if, given the flags that were given (-std=, -pedantic) we should issue an error, a warning --- 116,122 ---- typedef enum { SUCCESS = 1, FAILURE } ! gfc_try; /* This is returned by gfc_notification_std to know if, given the flags that were given (-std=, -pedantic) we should issue an error, a warning *************** bt; *** 145,151 **** /* Expression node types. */ typedef enum { EXPR_OP = 1, EXPR_FUNCTION, EXPR_CONSTANT, EXPR_VARIABLE, ! EXPR_SUBSTRING, EXPR_STRUCTURE, EXPR_ARRAY, EXPR_NULL } expr_t; --- 151,157 ---- /* Expression node types. */ typedef enum { EXPR_OP = 1, EXPR_FUNCTION, EXPR_CONSTANT, EXPR_VARIABLE, ! EXPR_SUBSTRING, EXPR_STRUCTURE, EXPR_ARRAY, EXPR_NULL, EXPR_COMPCALL } expr_t; *************** typedef enum *** 204,218 **** ST_CALL, ST_CASE, ST_CLOSE, ST_COMMON, ST_CONTINUE, ST_CONTAINS, ST_CYCLE, ST_DATA, ST_DATA_DECL, ST_DEALLOCATE, ST_DO, ST_ELSE, ST_ELSEIF, ST_ELSEWHERE, ST_END_BLOCK_DATA, ST_ENDDO, ST_IMPLIED_ENDDO, ! ST_END_FILE, ST_FLUSH, ST_END_FORALL, ST_END_FUNCTION, ST_ENDIF, ST_END_INTERFACE, ST_END_MODULE, ST_END_PROGRAM, ST_END_SELECT, ST_END_SUBROUTINE, ST_END_WHERE, ST_END_TYPE, ST_ENTRY, ST_EQUIVALENCE, ST_EXIT, ST_FORALL, ST_FORALL_BLOCK, ST_FORMAT, ST_FUNCTION, ST_GOTO, ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_IMPORT, ST_INQUIRE, ST_INTERFACE, ST_PARAMETER, ST_MODULE, ST_MODULE_PROC, ST_NAMELIST, ST_NULLIFY, ST_OPEN, ST_PAUSE, ST_PRIVATE, ST_PROGRAM, ST_PUBLIC, ST_READ, ST_RETURN, ST_REWIND, ! ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WRITE, ! ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE, ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT, ST_ENUM, ST_ENUMERATOR, ST_END_ENUM, ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_CRITICAL, --- 210,224 ---- ST_CALL, ST_CASE, ST_CLOSE, ST_COMMON, ST_CONTINUE, ST_CONTAINS, ST_CYCLE, ST_DATA, ST_DATA_DECL, ST_DEALLOCATE, ST_DO, ST_ELSE, ST_ELSEIF, ST_ELSEWHERE, ST_END_BLOCK_DATA, ST_ENDDO, ST_IMPLIED_ENDDO, ! ST_END_FILE, ST_FINAL, ST_FLUSH, ST_END_FORALL, ST_END_FUNCTION, ST_ENDIF, ST_END_INTERFACE, ST_END_MODULE, ST_END_PROGRAM, ST_END_SELECT, ST_END_SUBROUTINE, ST_END_WHERE, ST_END_TYPE, ST_ENTRY, ST_EQUIVALENCE, ST_EXIT, ST_FORALL, ST_FORALL_BLOCK, ST_FORMAT, ST_FUNCTION, ST_GOTO, ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_IMPORT, ST_INQUIRE, ST_INTERFACE, ST_PARAMETER, ST_MODULE, ST_MODULE_PROC, ST_NAMELIST, ST_NULLIFY, ST_OPEN, ST_PAUSE, ST_PRIVATE, ST_PROGRAM, ST_PUBLIC, ST_READ, ST_RETURN, ST_REWIND, ! ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WAIT, ! ST_WRITE, ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE, ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT, ST_ENUM, ST_ENUMERATOR, ST_END_ENUM, ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_CRITICAL, *************** typedef enum *** 222,228 **** ST_OMP_END_WORKSHARE, ST_OMP_DO, ST_OMP_FLUSH, ST_OMP_MASTER, ST_OMP_ORDERED, ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS, ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE, ! ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_PROCEDURE, ST_GET_FCN_CHARACTERISTICS, ST_NONE } gfc_statement; --- 228,235 ---- ST_OMP_END_WORKSHARE, ST_OMP_DO, ST_OMP_FLUSH, ST_OMP_MASTER, ST_OMP_ORDERED, ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS, ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE, ! ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_OMP_TASK, ST_OMP_END_TASK, ! ST_OMP_TASKWAIT, ST_PROCEDURE, ST_GENERIC, ST_GET_FCN_CHARACTERISTICS, ST_NONE } gfc_statement; *************** extern const mstring save_status[]; *** 295,301 **** enum gfc_isym_id { /* GFC_ISYM_NONE is used for intrinsics which will never be seen by ! the backend (eg. KIND). */ GFC_ISYM_NONE = 0, GFC_ISYM_ABORT, GFC_ISYM_ABS, --- 302,308 ---- enum gfc_isym_id { /* GFC_ISYM_NONE is used for intrinsics which will never be seen by ! the backend (e.g. KIND). */ GFC_ISYM_NONE = 0, GFC_ISYM_ABORT, GFC_ISYM_ABS, *************** enum gfc_isym_id *** 347,352 **** --- 354,360 ---- GFC_ISYM_EPSILON, GFC_ISYM_ERF, GFC_ISYM_ERFC, + GFC_ISYM_ERFC_SCALED, GFC_ISYM_ETIME, GFC_ISYM_EXIT, GFC_ISYM_EXP, *************** enum gfc_isym_id *** 379,384 **** --- 387,393 ---- GFC_ISYM_GMTIME, GFC_ISYM_HOSTNM, GFC_ISYM_HUGE, + GFC_ISYM_HYPOT, GFC_ISYM_IACHAR, GFC_ISYM_IAND, GFC_ISYM_IARGC, *************** enum gfc_isym_id *** 408,413 **** --- 417,423 ---- GFC_ISYM_KILL, GFC_ISYM_KIND, GFC_ISYM_LBOUND, + GFC_ISYM_LEADZ, GFC_ISYM_LEN, GFC_ISYM_LEN_TRIM, GFC_ISYM_LGAMMA, *************** enum gfc_isym_id *** 463,468 **** --- 473,479 ---- GFC_ISYM_RESHAPE, GFC_ISYM_RRSPACING, GFC_ISYM_RSHIFT, + GFC_ISYM_SC_KIND, GFC_ISYM_SCALE, GFC_ISYM_SCAN, GFC_ISYM_SECNDS, *************** enum gfc_isym_id *** 493,498 **** --- 504,510 ---- GFC_ISYM_TIME, GFC_ISYM_TIME8, GFC_ISYM_TINY, + GFC_ISYM_TRAILZ, GFC_ISYM_TRANSFER, GFC_ISYM_TRANSPOSE, GFC_ISYM_TRIM, *************** init_local_integer; *** 547,553 **** /* Used for keeping things in balanced binary trees. */ #define BBT_HEADER(self) int priority; struct self *left, *right ! #define NAMED_INTCST(a,b,c) a, typedef enum { ISOFORTRANENV_INVALID = -1, --- 559,565 ---- /* Used for keeping things in balanced binary trees. */ #define BBT_HEADER(self) int priority; struct self *left, *right ! #define NAMED_INTCST(a,b,c,d) a, typedef enum { ISOFORTRANENV_INVALID = -1, *************** typedef enum *** 557,563 **** iso_fortran_env_symbol; #undef NAMED_INTCST ! #define NAMED_INTCST(a,b,c) a, #define NAMED_REALCST(a,b,c) a, #define NAMED_CMPXCST(a,b,c) a, #define NAMED_LOGCST(a,b,c) a, --- 569,575 ---- iso_fortran_env_symbol; #undef NAMED_INTCST ! #define NAMED_INTCST(a,b,c,d) a, #define NAMED_REALCST(a,b,c) a, #define NAMED_CMPXCST(a,b,c) a, #define NAMED_LOGCST(a,b,c) a, *************** typedef struct *** 610,621 **** unsigned allocatable:1, dimension:1, external:1, intrinsic:1, optional:1, pointer:1, target:1, value:1, volatile_:1, dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1, ! implied_index:1, subref_array_pointer:1; ENUM_BITFIELD (save_state) save:2; unsigned data:1, /* Symbol is named in a DATA statement. */ ! protected:1, /* Symbol has been marked as protected. */ use_assoc:1, /* Symbol has been use-associated. */ use_only:1, /* Symbol has been use-associated, with ONLY. */ use_rename:1, /* Symbol has been use-associated and renamed. */ --- 622,633 ---- unsigned allocatable:1, dimension:1, external:1, intrinsic:1, optional:1, pointer:1, target:1, value:1, volatile_:1, dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1, ! implied_index:1, subref_array_pointer:1, proc_pointer:1; ENUM_BITFIELD (save_state) save:2; unsigned data:1, /* Symbol is named in a DATA statement. */ ! is_protected:1, /* Symbol has been marked as protected. */ use_assoc:1, /* Symbol has been use-associated. */ use_only:1, /* Symbol has been use-associated, with ONLY. */ use_rename:1, /* Symbol has been use-associated and renamed. */ *************** typedef struct *** 625,633 **** unsigned function:1, subroutine:1, procedure:1; unsigned generic:1, generic_copy:1; unsigned implicit_type:1; /* Type defined via implicit rules. */ ! unsigned untyped:1; /* No implicit type could be found. */ ! unsigned is_bind_c:1; /* say if is bound to C */ /* These flags are both in the typespec and attribute. The attribute list is what gets read from/written to a module file. The typespec --- 637,646 ---- unsigned function:1, subroutine:1, procedure:1; unsigned generic:1, generic_copy:1; unsigned implicit_type:1; /* Type defined via implicit rules. */ ! unsigned untyped:1; /* No implicit type could be found. */ ! unsigned is_bind_c:1; /* say if is bound to C. */ ! unsigned extension:1; /* extends a derived type. */ /* These flags are both in the typespec and attribute. The attribute list is what gets read from/written to a module file. The typespec *************** typedef struct *** 681,687 **** unsigned cray_pointer:1, cray_pointee:1; /* The symbol is a derived type with allocatable components, pointer ! components or private components, possibly nested. zer_comp is true if the derived type has no component at all. */ unsigned alloc_comp:1, pointer_comp:1, private_comp:1, zero_comp:1; --- 694,700 ---- unsigned cray_pointer:1, cray_pointee:1; /* The symbol is a derived type with allocatable components, pointer ! components or private components, possibly nested. zero_comp is true if the derived type has no component at all. */ unsigned alloc_comp:1, pointer_comp:1, private_comp:1, zero_comp:1; *************** typedef struct *** 691,696 **** --- 704,724 ---- symbol_attribute; + /* We need to store source lines as sequences of multibyte source + characters. We define here a type wide enough to hold any multibyte + source character, just like libcpp does. A 32-bit type is enough. */ + + #if HOST_BITS_PER_INT >= 32 + typedef unsigned int gfc_char_t; + #elif HOST_BITS_PER_LONG >= 32 + typedef unsigned long gfc_char_t; + #elif defined(HAVE_LONG_LONG) && (HOST_BITS_PER_LONGLONG >= 32) + typedef unsigned long long gfc_char_t; + #else + # error "Cannot find an integer type with at least 32 bits" + #endif + + /* The following three structures are used to identify a location in the sources. *************** typedef struct gfc_file *** 713,743 **** typedef struct gfc_linebuf { - #ifdef USE_MAPPED_LOCATION source_location location; - #else - int linenum; - #endif struct gfc_file *file; struct gfc_linebuf *next; int truncated; bool dbg_emitted; ! char line[1]; } gfc_linebuf; #define gfc_linebuf_header_size (offsetof (gfc_linebuf, line)) - #ifdef USE_MAPPED_LOCATION #define gfc_linebuf_linenum(LBUF) (LOCATION_LINE ((LBUF)->location)) - #else - #define gfc_linebuf_linenum(LBUF) ((LBUF)->linenum) - #endif typedef struct { ! char *nextc; gfc_linebuf *lb; } locus; --- 741,763 ---- typedef struct gfc_linebuf { source_location location; struct gfc_file *file; struct gfc_linebuf *next; int truncated; bool dbg_emitted; ! gfc_char_t line[1]; } gfc_linebuf; #define gfc_linebuf_header_size (offsetof (gfc_linebuf, line)) #define gfc_linebuf_linenum(LBUF) (LOCATION_LINE ((LBUF)->location)) typedef struct { ! gfc_char_t *nextc; gfc_linebuf *lb; } locus; *************** typedef struct *** 750,756 **** #endif ! extern int gfc_suppress_error; /* Character length structures hold the expression that gives the --- 770,779 ---- #endif ! /* Suppress error messages or re-enable them. */ ! ! void gfc_push_suppress_errors (void); ! void gfc_pop_suppress_errors (void); /* Character length structures hold the expression that gives the *************** typedef struct gfc_charlen *** 768,780 **** { struct gfc_expr *length; struct gfc_charlen *next; tree backend_decl; int resolved; } gfc_charlen; ! #define gfc_get_charlen() gfc_getmem(sizeof(gfc_charlen)) /* Type specification structure. FIXME: derived and cl could be union??? */ typedef struct --- 791,804 ---- { struct gfc_expr *length; struct gfc_charlen *next; + bool length_from_typespec; /* Length from explicit array ctor typespec? */ tree backend_decl; int resolved; } gfc_charlen; ! #define gfc_get_charlen() XCNEW (gfc_charlen) /* Type specification structure. FIXME: derived and cl could be union??? */ typedef struct *************** typedef struct *** 783,788 **** --- 807,813 ---- int kind; struct gfc_symbol *derived; gfc_charlen *cl; /* For character types only. */ + struct gfc_symbol *interface; /* For PROCEDURE declarations. */ int is_c_interop; int is_iso_c; bt f90_type; *************** typedef struct *** 805,811 **** } gfc_array_spec; ! #define gfc_get_array_spec() gfc_getmem(sizeof(gfc_array_spec)) /* Components of derived types. */ --- 830,836 ---- } gfc_array_spec; ! #define gfc_get_array_spec() XCNEW (gfc_array_spec) /* Components of derived types. */ *************** typedef struct gfc_component *** 814,821 **** const char *name; gfc_typespec ts; ! int pointer, allocatable, dimension; ! gfc_access access; gfc_array_spec *as; tree backend_decl; --- 839,845 ---- const char *name; gfc_typespec ts; ! symbol_attribute attr; gfc_array_spec *as; tree backend_decl; *************** typedef struct gfc_component *** 825,831 **** } gfc_component; ! #define gfc_get_component() gfc_getmem(sizeof(gfc_component)) /* Formal argument lists are lists of symbols. */ typedef struct gfc_formal_arglist --- 849,855 ---- } gfc_component; ! #define gfc_get_component() XCNEW (gfc_component) /* Formal argument lists are lists of symbols. */ typedef struct gfc_formal_arglist *************** typedef struct gfc_formal_arglist *** 837,843 **** } gfc_formal_arglist; ! #define gfc_get_formal_arglist() gfc_getmem(sizeof(gfc_formal_arglist)) /* The gfc_actual_arglist structure is for actual arguments. */ --- 861,867 ---- } gfc_formal_arglist; ! #define gfc_get_formal_arglist() XCNEW (gfc_formal_arglist) /* The gfc_actual_arglist structure is for actual arguments. */ *************** typedef struct gfc_actual_arglist *** 857,863 **** } gfc_actual_arglist; ! #define gfc_get_actual_arglist() gfc_getmem(sizeof(gfc_actual_arglist)) /* Because a symbol can belong to multiple namelists, they must be --- 881,887 ---- } gfc_actual_arglist; ! #define gfc_get_actual_arglist() XCNEW (gfc_actual_arglist) /* Because a symbol can belong to multiple namelists, they must be *************** typedef struct gfc_namelist *** 869,875 **** } gfc_namelist; ! #define gfc_get_namelist() gfc_getmem(sizeof(gfc_namelist)) enum { --- 893,899 ---- } gfc_namelist; ! #define gfc_get_namelist() XCNEW (gfc_namelist) enum { *************** typedef struct gfc_omp_clauses *** 909,915 **** OMP_SCHED_STATIC, OMP_SCHED_DYNAMIC, OMP_SCHED_GUIDED, ! OMP_SCHED_RUNTIME } sched_kind; struct gfc_expr *chunk_size; enum --- 933,940 ---- OMP_SCHED_STATIC, OMP_SCHED_DYNAMIC, OMP_SCHED_GUIDED, ! OMP_SCHED_RUNTIME, ! OMP_SCHED_AUTO } sched_kind; struct gfc_expr *chunk_size; enum *************** typedef struct gfc_omp_clauses *** 917,929 **** OMP_DEFAULT_UNKNOWN, OMP_DEFAULT_NONE, OMP_DEFAULT_PRIVATE, ! OMP_DEFAULT_SHARED } default_sharing; ! bool nowait, ordered; } gfc_omp_clauses; ! #define gfc_get_omp_clauses() gfc_getmem(sizeof(gfc_omp_clauses)) /* The gfc_st_label structure is a doubly linked list attached to a --- 942,956 ---- OMP_DEFAULT_UNKNOWN, OMP_DEFAULT_NONE, OMP_DEFAULT_PRIVATE, ! OMP_DEFAULT_SHARED, ! OMP_DEFAULT_FIRSTPRIVATE } default_sharing; ! int collapse; ! bool nowait, ordered, untied; } gfc_omp_clauses; ! #define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses) /* The gfc_st_label structure is a doubly linked list attached to a *************** typedef struct gfc_interface *** 956,975 **** } gfc_interface; ! #define gfc_get_interface() gfc_getmem(sizeof(gfc_interface)) ! /* User operator nodes. These are like stripped down symbols. */ typedef struct { const char *name; ! gfc_interface *operator; struct gfc_namespace *ns; gfc_access access; } gfc_user_op; /* Symbol nodes. These are important things. They are what the standard refers to as "entities". The possibly multiple names that refer to the same entity are accomplished by a binary tree of --- 983,1052 ---- } gfc_interface; ! #define gfc_get_interface() XCNEW (gfc_interface) /* User operator nodes. These are like stripped down symbols. */ typedef struct { const char *name; ! gfc_interface *op; struct gfc_namespace *ns; gfc_access access; } gfc_user_op; + + /* A list of specific bindings that are associated with a generic spec. */ + typedef struct gfc_tbp_generic + { + /* The parser sets specific_st, upon resolution we look for the corresponding + gfc_typebound_proc and set specific for further use. */ + struct gfc_symtree* specific_st; + struct gfc_typebound_proc* specific; + + struct gfc_tbp_generic* next; + } + gfc_tbp_generic; + + #define gfc_get_tbp_generic() XCNEW (gfc_tbp_generic) + + + /* Data needed for type-bound procedures. */ + typedef struct gfc_typebound_proc + { + locus where; /* Where the PROCEDURE/GENERIC definition was. */ + + union + { + struct gfc_symtree* specific; + gfc_tbp_generic* generic; + } + u; + + gfc_access access; + char* pass_arg; /* Argument-name for PASS. NULL if not specified. */ + + /* The overridden type-bound proc (or GENERIC with this name in the + parent-type) or NULL if non. */ + struct gfc_typebound_proc* overridden; + + /* Once resolved, we use the position of pass_arg in the formal arglist of + the binding-target procedure to identify it. The first argument has + number 1 here, the second 2, and so on. */ + unsigned pass_arg_num; + + unsigned nopass:1; /* Whether we have NOPASS (PASS otherwise). */ + unsigned non_overridable:1; + unsigned is_generic:1; + unsigned function:1, subroutine:1; + unsigned error:1; /* Ignore it, when an error occurred during resolution. */ + } + gfc_typebound_proc; + + #define gfc_get_typebound_proc() XCNEW (gfc_typebound_proc) + + /* Symbol nodes. These are important things. They are what the standard refers to as "entities". The possibly multiple names that refer to the same entity are accomplished by a binary tree of *************** typedef struct gfc_symbol *** 985,991 **** gfc_typespec ts; symbol_attribute attr; ! /* The interface member points to the formal argument list if the symbol is a function or subroutine name. If the symbol is a generic name, the generic member points to the list of interfaces. */ --- 1062,1068 ---- gfc_typespec ts; symbol_attribute attr; ! /* The formal member points to the formal argument list if the symbol is a function or subroutine name. If the symbol is a generic name, the generic member points to the list of interfaces. */ *************** typedef struct gfc_symbol *** 995,1008 **** gfc_formal_arglist *formal; struct gfc_namespace *formal_ns; struct gfc_expr *value; /* Parameter/Initializer value */ gfc_array_spec *as; struct gfc_symbol *result; /* function result symbol */ gfc_component *components; /* Derived type components */ - struct gfc_symbol *interface; /* For PROCEDURE declarations. */ - /* Defined only for Cray pointees; points to their pointer. */ struct gfc_symbol *cp_pointer; --- 1072,1084 ---- gfc_formal_arglist *formal; struct gfc_namespace *formal_ns; + struct gfc_namespace *f2k_derived; struct gfc_expr *value; /* Parameter/Initializer value */ gfc_array_spec *as; struct gfc_symbol *result; /* function result symbol */ gfc_component *components; /* Derived type components */ /* Defined only for Cray pointees; points to their pointer. */ struct gfc_symbol *cp_pointer; *************** typedef struct gfc_symbol *** 1028,1034 **** the old symbol. */ struct gfc_symbol *old_symbol, *tlink; ! unsigned mark:1, new:1; /* Nonzero if all equivalences associated with this symbol have been processed. */ unsigned equiv_built:1; --- 1104,1110 ---- the old symbol. */ struct gfc_symbol *old_symbol, *tlink; ! unsigned mark:1, gfc_new:1; /* Nonzero if all equivalences associated with this symbol have been processed. */ unsigned equiv_built:1; *************** typedef struct gfc_common_head *** 1068,1074 **** } gfc_common_head; ! #define gfc_get_common_head() gfc_getmem(sizeof(gfc_common_head)) /* A list of all the alternate entry points for a procedure. */ --- 1144,1150 ---- } gfc_common_head; ! #define gfc_get_common_head() XCNEW (gfc_common_head) /* A list of all the alternate entry points for a procedure. */ *************** typedef struct gfc_entry_list *** 1081,1087 **** int id; /* The LABEL_EXPR marking this entry point. */ tree label; ! /* The nest item in the list. */ struct gfc_entry_list *next; } gfc_entry_list; --- 1157,1163 ---- int id; /* The LABEL_EXPR marking this entry point. */ tree label; ! /* The next item in the list. */ struct gfc_entry_list *next; } gfc_entry_list; *************** gfc_entry_list; *** 1089,1094 **** --- 1165,1200 ---- #define gfc_get_entry_list() \ (gfc_entry_list *) gfc_getmem(sizeof(gfc_entry_list)) + /* Lists of rename info for the USE statement. */ + + typedef struct gfc_use_rename + { + char local_name[GFC_MAX_SYMBOL_LEN + 1], use_name[GFC_MAX_SYMBOL_LEN + 1]; + struct gfc_use_rename *next; + int found; + gfc_intrinsic_op op; + locus where; + } + gfc_use_rename; + + #define gfc_get_use_rename() XCNEW (gfc_use_rename); + + /* A list of all USE statements in a namespace. */ + + typedef struct gfc_use_list + { + const char *module_name; + int only_flag; + struct gfc_use_rename *rename; + locus where; + /* Next USE statement. */ + struct gfc_use_list *next; + } + gfc_use_list; + + #define gfc_get_use_list() \ + (gfc_use_list *) gfc_getmem(sizeof(gfc_use_list)) + /* Within a namespace, symbols are pointed to by symtree nodes that are linked together in a balanced binary tree. There can be several symtrees pointing to the same symbol node via USE *************** typedef struct gfc_symtree *** 1107,1112 **** --- 1213,1220 ---- } n; + /* Data for type-bound procedures; NULL if no type-bound procedure. */ + gfc_typebound_proc* typebound; } gfc_symtree; *************** typedef struct gfc_dt_list *** 1118,1124 **** } gfc_dt_list; ! #define gfc_get_dt_list() gfc_getmem(sizeof(gfc_dt_list)) /* A list of all derived types. */ extern gfc_dt_list *gfc_derived_types; --- 1226,1232 ---- } gfc_dt_list; ! #define gfc_get_dt_list() XCNEW (gfc_dt_list) /* A list of all derived types. */ extern gfc_dt_list *gfc_derived_types; *************** typedef struct gfc_namespace *** 1135,1145 **** --- 1243,1257 ---- gfc_symtree *uop_root; /* Tree containing all the common blocks. */ gfc_symtree *common_root; + /* Linked list of finalizer procedures. */ + struct gfc_finalizer *finalizers; /* If set_flag[letter] is set, an implicit type has been set for letter. */ int set_flag[GFC_LETTERS]; /* Keeps track of the implicit types associated with the letters. */ gfc_typespec default_type[GFC_LETTERS]; + /* Store the positions of IMPLICIT statements. */ + locus implicit_loc[GFC_LETTERS]; /* If this is a namespace of a procedure, this points to the procedure. */ struct gfc_symbol *proc_name; *************** typedef struct gfc_namespace *** 1153,1159 **** /* Points to the equivalence groups produced by trans_common. */ struct gfc_equiv_list *equiv_lists; ! gfc_interface *operator[GFC_INTRINSIC_OPS]; /* Points to the parent namespace, i.e. the namespace of a module or procedure in which the procedure belonging to this namespace is --- 1265,1271 ---- /* Points to the equivalence groups produced by trans_common. */ struct gfc_equiv_list *equiv_lists; ! gfc_interface *op[GFC_INTRINSIC_OPS]; /* Points to the parent namespace, i.e. the namespace of a module or procedure in which the procedure belonging to this namespace is *************** typedef struct gfc_namespace *** 1173,1179 **** this namespace. */ struct gfc_data *data; ! gfc_charlen *cl_list; int save_all, seen_save, seen_implicit_none; --- 1285,1291 ---- this namespace. */ struct gfc_data *data; ! gfc_charlen *cl_list, *old_cl_list; int save_all, seen_save, seen_implicit_none; *************** typedef struct gfc_namespace *** 1185,1190 **** --- 1297,1305 ---- /* A list of all alternate entry points to this procedure (or NULL). */ gfc_entry_list *entries; + /* A list of USE statements in this namespace. */ + gfc_use_list *use_stmts; + /* Set to 1 if namespace is a BLOCK DATA program unit. */ int is_block_data; *************** typedef struct gfc_array_ref *** 1251,1257 **** } gfc_array_ref; ! #define gfc_get_array_ref() gfc_getmem(sizeof(gfc_array_ref)) /* Component reference nodes. A variable is stored as an expression --- 1366,1372 ---- } gfc_array_ref; ! #define gfc_get_array_ref() XCNEW (gfc_array_ref) /* Component reference nodes. A variable is stored as an expression *************** typedef struct gfc_ref *** 1293,1299 **** } gfc_ref; ! #define gfc_get_ref() gfc_getmem(sizeof(gfc_ref)) /* Structures representing intrinsic symbols and their arguments lists. */ --- 1408,1414 ---- } gfc_ref; ! #define gfc_get_ref() XCNEW (gfc_ref) /* Structures representing intrinsic symbols and their arguments lists. */ *************** gfc_intrinsic_arg; *** 1320,1335 **** typedef union { ! try (*f0)(void); ! try (*f1)(struct gfc_expr *); ! try (*f1m)(gfc_actual_arglist *); ! try (*f2)(struct gfc_expr *, struct gfc_expr *); ! try (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *); ! try (*f3ml)(gfc_actual_arglist *); ! try (*f3red)(gfc_actual_arglist *); ! try (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *, struct gfc_expr *); ! try (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *, struct gfc_expr *, struct gfc_expr *); } gfc_check_f; --- 1435,1450 ---- typedef union { ! gfc_try (*f0)(void); ! gfc_try (*f1)(struct gfc_expr *); ! gfc_try (*f1m)(gfc_actual_arglist *); ! gfc_try (*f2)(struct gfc_expr *, struct gfc_expr *); ! gfc_try (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *); ! gfc_try (*f3ml)(gfc_actual_arglist *); ! gfc_try (*f3red)(gfc_actual_arglist *); ! gfc_try (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *, struct gfc_expr *); ! gfc_try (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *, struct gfc_expr *, struct gfc_expr *); } gfc_check_f; *************** gfc_intrinsic_sym; *** 1402,1412 **** EXPR_FUNCTION Function call, symbol points to function's name EXPR_CONSTANT A scalar constant: Logical, String, Real, Int or Complex EXPR_VARIABLE An Lvalue with a root symbol and possible reference list ! which expresses structure, array and substring refs. EXPR_NULL The NULL pointer value (which also has a basic type). EXPR_SUBSTRING A substring of a constant string EXPR_STRUCTURE A structure constructor ! EXPR_ARRAY An array constructor. */ #include #include --- 1517,1529 ---- EXPR_FUNCTION Function call, symbol points to function's name EXPR_CONSTANT A scalar constant: Logical, String, Real, Int or Complex EXPR_VARIABLE An Lvalue with a root symbol and possible reference list ! which expresses structure, array and substring refs. EXPR_NULL The NULL pointer value (which also has a basic type). EXPR_SUBSTRING A substring of a constant string EXPR_STRUCTURE A structure constructor ! EXPR_ARRAY An array constructor. ! EXPR_COMPCALL Function (or subroutine) call of a procedure pointer ! component or type-bound procedure. */ #include #include *************** typedef struct gfc_expr *** 1421,1427 **** int rank; mpz_t *shape; /* Can be NULL if shape is unknown at compile time */ ! /* Nonnull for functions and structure constructors */ gfc_symtree *symtree; gfc_ref *ref; --- 1538,1545 ---- int rank; mpz_t *shape; /* Can be NULL if shape is unknown at compile time */ ! /* Nonnull for functions and structure constructors, the base object for ! component-calls. */ gfc_symtree *symtree; gfc_ref *ref; *************** typedef struct gfc_expr *** 1458,1463 **** --- 1576,1583 ---- { int logical; + io_kind iokind; + mpz_t integer; mpfr_t real; *************** typedef struct gfc_expr *** 1470,1476 **** struct { ! gfc_intrinsic_op operator; gfc_user_op *uop; struct gfc_expr *op1, *op2; } --- 1590,1596 ---- struct { ! gfc_intrinsic_op op; gfc_user_op *uop; struct gfc_expr *op1, *op2; } *************** typedef struct gfc_expr *** 1487,1494 **** struct { int length; ! char *string; } character; --- 1607,1622 ---- struct { + gfc_actual_arglist* actual; + gfc_typebound_proc* tbp; + const char* name; + } + compcall; + + struct + { int length; ! gfc_char_t *string; } character; *************** gfc_real_info; *** 1558,1563 **** --- 1686,1700 ---- extern gfc_real_info gfc_real_kinds[]; + typedef struct + { + int kind, bit_size; + const char *name; + } + gfc_character_info; + + extern gfc_character_info gfc_character_kinds[]; + /* Equivalence structures. Equivalent lvalues are linked along the *eq pointer, equivalence sets are strung along the *next node. */ *************** typedef struct gfc_equiv *** 1570,1576 **** } gfc_equiv; ! #define gfc_get_equiv() gfc_getmem(sizeof(gfc_equiv)) /* Holds a single equivalence member after processing. */ typedef struct gfc_equiv_info --- 1707,1713 ---- } gfc_equiv; ! #define gfc_get_equiv() XCNEW (gfc_equiv) /* Holds a single equivalence member after processing. */ typedef struct gfc_equiv_info *************** typedef struct gfc_case *** 1622,1628 **** } gfc_case; ! #define gfc_get_case() gfc_getmem(sizeof(gfc_case)) typedef struct --- 1759,1765 ---- } gfc_case; ! #define gfc_get_case() XCNEW (gfc_case) typedef struct *************** typedef struct *** 1631,1637 **** } gfc_iterator; ! #define gfc_get_iterator() gfc_getmem(sizeof(gfc_iterator)) /* Allocation structure for ALLOCATE, DEALLOCATE and NULLIFY statements. */ --- 1768,1774 ---- } gfc_iterator; ! #define gfc_get_iterator() XCNEW (gfc_iterator) /* Allocation structure for ALLOCATE, DEALLOCATE and NULLIFY statements. */ *************** typedef struct gfc_alloc *** 1643,1655 **** } gfc_alloc; ! #define gfc_get_alloc() gfc_getmem(sizeof(gfc_alloc)) typedef struct { gfc_expr *unit, *file, *status, *access, *form, *recl, ! *blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert; gfc_st_label *err; } gfc_open; --- 1780,1793 ---- } gfc_alloc; ! #define gfc_get_alloc() XCNEW (gfc_alloc) typedef struct { gfc_expr *unit, *file, *status, *access, *form, *recl, ! *blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert, ! *decimal, *encoding, *round, *sign, *asynchronous, *id; gfc_st_label *err; } gfc_open; *************** typedef struct *** 1676,1682 **** gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named, *name, *access, *sequential, *direct, *form, *formatted, *unformatted, *recl, *nextrec, *blank, *position, *action, *read, ! *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos; gfc_st_label *err; --- 1814,1821 ---- gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named, *name, *access, *sequential, *direct, *form, *formatted, *unformatted, *recl, *nextrec, *blank, *position, *action, *read, ! *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos, ! *asynchronous, *decimal, *encoding, *pending, *round, *sign, *size, *id; gfc_st_label *err; *************** gfc_inquire; *** 1686,1692 **** typedef struct { ! gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg; gfc_symbol *namelist; /* A format_label of `format_asterisk' indicates the "*" format */ --- 1825,1841 ---- typedef struct { ! gfc_expr *unit, *iostat, *iomsg, *id; ! gfc_st_label *err, *end, *eor; ! } ! gfc_wait; ! ! ! typedef struct ! { ! gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg, ! *id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round, ! *sign, *extra_comma; gfc_symbol *namelist; /* A format_label of `format_asterisk' indicates the "*" format */ *************** gfc_forall_iterator; *** 1710,1721 **** typedef enum { EXEC_NOP = 1, EXEC_ASSIGN, EXEC_LABEL_ASSIGN, EXEC_POINTER_ASSIGN, ! EXEC_GOTO, EXEC_CALL, EXEC_ASSIGN_CALL, EXEC_RETURN, EXEC_ENTRY, ! EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE, EXEC_INIT_ASSIGN, EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT, EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT, EXEC_ALLOCATE, EXEC_DEALLOCATE, ! EXEC_OPEN, EXEC_CLOSE, EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END, EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH, EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER, --- 1859,1870 ---- typedef enum { EXEC_NOP = 1, EXEC_ASSIGN, EXEC_LABEL_ASSIGN, EXEC_POINTER_ASSIGN, ! EXEC_GOTO, EXEC_CALL, EXEC_COMPCALL, EXEC_ASSIGN_CALL, EXEC_RETURN, ! EXEC_ENTRY, EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE, EXEC_INIT_ASSIGN, EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT, EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT, EXEC_ALLOCATE, EXEC_DEALLOCATE, ! 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_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER, *************** typedef enum *** 1723,1729 **** EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE, EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE, EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT, ! EXEC_OMP_END_SINGLE } gfc_exec_op; --- 1872,1878 ---- EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE, EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE, EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT, ! EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT } gfc_exec_op; *************** typedef struct gfc_code *** 1741,1746 **** --- 1890,1896 ---- symbol for the interface definition. const char *sub_name; */ gfc_symbol *resolved_sym; + gfc_intrinsic_sym *resolved_isym; union { *************** typedef struct gfc_code *** 1752,1757 **** --- 1902,1908 ---- gfc_close *close; gfc_filepos *filepos; gfc_inquire *inquire; + gfc_wait *wait; gfc_dt *dt; gfc_forall_iterator *forall_iterator; struct gfc_code *whichloop; *************** typedef struct *** 1819,1825 **** int max_continue_fixed; int max_continue_free; int max_identifier_length; ! int verbose; int warn_aliasing; int warn_ampersand; --- 1970,1976 ---- int max_continue_fixed; int max_continue_free; int max_identifier_length; ! int dump_parse_tree; int warn_aliasing; int warn_ampersand; *************** typedef struct *** 1829,1835 **** --- 1980,1990 ---- int warn_surprising; int warn_tabs; int warn_underflow; + int warn_intrinsic_shadow; + int warn_intrinsics_std; int warn_character_truncation; + int warn_array_temp; + int warn_align_commons; int max_errors; int flag_all_intrinsics; *************** typedef struct *** 1841,1846 **** --- 1996,2002 ---- int flag_second_underscore; int flag_implicit_none; int flag_max_stack_var_size; + int flag_max_array_constructor; int flag_range_check; int flag_pack_derived; int flag_repack_arrays; *************** typedef struct *** 1849,1854 **** --- 2005,2011 ---- int flag_automatic; int flag_backslash; int flag_backtrace; + int flag_check_array_temporaries; int flag_allow_leading_underscore; int flag_dump_core; int flag_external_blas; *************** typedef struct *** 1866,1877 **** int flag_init_logical; int flag_init_character; char flag_init_character_value; int fpe; int warn_std; int allow_std; - int warn_nonstd_intrinsics; int fshort_enums; int convert; int record_marker; --- 2023,2034 ---- int flag_init_logical; int flag_init_character; char flag_init_character_value; + int flag_align_commons; int fpe; int warn_std; int allow_std; int fshort_enums; int convert; int record_marker; *************** typedef struct iterator_stack *** 1910,1915 **** --- 2067,2093 ---- iterator_stack; extern iterator_stack *iter_stack; + + /* Node in the linked list used for storing finalizer procedures. */ + + typedef struct gfc_finalizer + { + struct gfc_finalizer* next; + locus where; /* Where the FINAL declaration occurred. */ + + /* Up to resolution, we want the gfc_symbol, there we lookup the corresponding + symtree and later need only that. This way, we can access and call the + finalizers from every context as they should be "always accessible". I + don't make this a union because we need the information whether proc_sym is + still referenced or not for dereferencing it on deleting a gfc_finalizer + structure. */ + gfc_symbol* proc_sym; + gfc_symtree* proc_tree; + } + gfc_finalizer; + #define gfc_get_finalizer() XCNEW (gfc_finalizer) + + /************************ Function prototypes *************************/ /* decl.c */ *************** bool gfc_in_match_data (void); *** 1919,1925 **** void gfc_scanner_done_1 (void); void gfc_scanner_init_1 (void); ! void gfc_add_include_path (const char *, bool); void gfc_add_intrinsic_modules_path (const char *); void gfc_release_include_path (void); FILE *gfc_open_included_file (const char *, bool, bool); --- 2097,2103 ---- void gfc_scanner_done_1 (void); void gfc_scanner_init_1 (void); ! void gfc_add_include_path (const char *, bool, bool); void gfc_add_intrinsic_modules_path (const char *); void gfc_release_include_path (void); FILE *gfc_open_included_file (const char *, bool, bool); *************** void gfc_advance_line (void); *** 1933,1945 **** int gfc_check_include (void); int gfc_define_undef_line (void); void gfc_skip_comments (void); ! int gfc_next_char_literal (int); ! int gfc_next_char (void); ! int gfc_peek_char (void); void gfc_error_recovery (void); void gfc_gobble_whitespace (void); ! try gfc_new_file (void); const char * gfc_read_orig_filename (const char *, const char **); extern gfc_source_form gfc_current_form; --- 2111,2138 ---- int gfc_check_include (void); int gfc_define_undef_line (void); + int gfc_wide_is_printable (gfc_char_t); + int gfc_wide_is_digit (gfc_char_t); + int gfc_wide_fits_in_byte (gfc_char_t); + gfc_char_t gfc_wide_tolower (gfc_char_t); + gfc_char_t gfc_wide_toupper (gfc_char_t); + size_t gfc_wide_strlen (const gfc_char_t *); + int gfc_wide_strncasecmp (const gfc_char_t *, const char *, size_t); + gfc_char_t *gfc_wide_memset (gfc_char_t *, gfc_char_t, size_t); + char *gfc_widechar_to_char (const gfc_char_t *, int); + gfc_char_t *gfc_char_to_widechar (const char *); + + #define gfc_get_wide_string(n) XCNEWVEC (gfc_char_t, n) + void gfc_skip_comments (void); ! gfc_char_t gfc_next_char_literal (int); ! gfc_char_t gfc_next_char (void); ! char gfc_next_ascii_char (void); ! gfc_char_t gfc_peek_char (void); ! char gfc_peek_ascii_char (void); void gfc_error_recovery (void); void gfc_gobble_whitespace (void); ! gfc_try gfc_new_file (void); const char * gfc_read_orig_filename (const char *, const char **); extern gfc_source_form gfc_current_form; *************** bool gfc_post_options (const char **); *** 1976,1981 **** --- 2169,2175 ---- /* iresolve.c */ const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1; + bool gfc_find_sym_in_expr (gfc_symbol *, gfc_expr *); /* error.c */ *************** typedef struct gfc_error_buf *** 1989,1994 **** --- 2183,2190 ---- void gfc_error_init_1 (void); void gfc_buffer_error (int); + const char *gfc_print_wide_char (gfc_char_t); + void gfc_warning (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); void gfc_warning_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); void gfc_clear_warning (void); *************** int gfc_error_check (void); *** 2003,2009 **** int gfc_error_flag_test (void); notification gfc_notification_std (int); ! try gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3); /* A general purpose syntax error. */ #define gfc_syntax_error(ST) \ --- 2199,2205 ---- int gfc_error_flag_test (void); notification gfc_notification_std (int); ! gfc_try gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3); /* A general purpose syntax error. */ #define gfc_syntax_error(ST) \ *************** void gfc_push_error (gfc_error_buf *); *** 2013,2021 **** void gfc_pop_error (gfc_error_buf *); void gfc_free_error (gfc_error_buf *); - void gfc_status (const char *, ...) ATTRIBUTE_PRINTF_1; - void gfc_status_char (char); - void gfc_get_errors (int *, int *); /* arith.c */ --- 2209,2214 ---- *************** void gfc_arith_init_1 (void); *** 2023,2032 **** void gfc_arith_done_1 (void); gfc_expr *gfc_enum_initializer (gfc_expr *, locus); arith gfc_check_integer_range (mpz_t p, int kind); /* trans-types.c */ ! try gfc_validate_c_kind (gfc_typespec *); ! try gfc_check_any_c_kind (gfc_typespec *); int gfc_validate_kind (bt, int, bool); extern int gfc_index_integer_kind; extern int gfc_default_integer_kind; --- 2216,2225 ---- void gfc_arith_done_1 (void); gfc_expr *gfc_enum_initializer (gfc_expr *, locus); arith gfc_check_integer_range (mpz_t p, int kind); + bool gfc_check_character_range (gfc_char_t, int); /* trans-types.c */ ! gfc_try gfc_check_any_c_kind (gfc_typespec *); int gfc_validate_kind (bt, int, bool); extern int gfc_index_integer_kind; extern int gfc_default_integer_kind; *************** extern int gfc_character_storage_size; *** 2044,2120 **** /* symbol.c */ void gfc_clear_new_implicit (void); ! try gfc_add_new_implicit_range (int, int); ! try gfc_merge_new_implicit (gfc_typespec *); void gfc_set_implicit_none (void); void gfc_check_function_type (gfc_namespace *); bool gfc_is_intrinsic_typename (const char *); gfc_typespec *gfc_get_default_type (gfc_symbol *, gfc_namespace *); ! try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *); ! ! void gfc_set_component_attr (gfc_component *, symbol_attribute *); ! void gfc_get_component_attr (symbol_attribute *, gfc_component *); void gfc_set_sym_referenced (gfc_symbol *); ! try gfc_add_attribute (symbol_attribute *, locus *); ! try gfc_add_allocatable (symbol_attribute *, locus *); ! try gfc_add_dimension (symbol_attribute *, const char *, locus *); ! try gfc_add_external (symbol_attribute *, locus *); ! try gfc_add_intrinsic (symbol_attribute *, locus *); ! try gfc_add_optional (symbol_attribute *, locus *); ! try gfc_add_pointer (symbol_attribute *, locus *); ! try gfc_add_cray_pointer (symbol_attribute *, locus *); ! try gfc_add_cray_pointee (symbol_attribute *, locus *); ! try gfc_mod_pointee_as (gfc_array_spec *); ! try gfc_add_protected (symbol_attribute *, const char *, locus *); ! try gfc_add_result (symbol_attribute *, const char *, locus *); ! try gfc_add_save (symbol_attribute *, const char *, locus *); ! try gfc_add_threadprivate (symbol_attribute *, const char *, locus *); ! try gfc_add_saved_common (symbol_attribute *, locus *); ! try gfc_add_target (symbol_attribute *, locus *); ! try gfc_add_dummy (symbol_attribute *, const char *, locus *); ! try gfc_add_generic (symbol_attribute *, const char *, locus *); ! try gfc_add_common (symbol_attribute *, locus *); ! try gfc_add_in_common (symbol_attribute *, const char *, locus *); ! try gfc_add_in_equivalence (symbol_attribute *, const char *, locus *); ! try gfc_add_data (symbol_attribute *, const char *, locus *); ! try gfc_add_in_namelist (symbol_attribute *, const char *, locus *); ! try gfc_add_sequence (symbol_attribute *, const char *, locus *); ! try gfc_add_elemental (symbol_attribute *, locus *); ! try gfc_add_pure (symbol_attribute *, locus *); ! try gfc_add_recursive (symbol_attribute *, locus *); ! try gfc_add_function (symbol_attribute *, const char *, locus *); ! try gfc_add_subroutine (symbol_attribute *, const char *, locus *); ! try gfc_add_volatile (symbol_attribute *, const char *, locus *); ! try gfc_add_proc (symbol_attribute *attr, const char *name, locus *where); ! try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *); ! try gfc_add_is_bind_c(symbol_attribute *, const char *, locus *, int); ! try gfc_add_value (symbol_attribute *, const char *, locus *); ! try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *); ! try gfc_add_entry (symbol_attribute *, const char *, locus *); ! try gfc_add_procedure (symbol_attribute *, procedure_type, const char *, locus *); ! try gfc_add_intent (symbol_attribute *, sym_intent, locus *); ! try gfc_add_explicit_interface (gfc_symbol *, ifsrc, gfc_formal_arglist *, locus *); ! try gfc_add_type (gfc_symbol *, gfc_typespec *, locus *); void gfc_clear_attr (symbol_attribute *); ! try gfc_missing_attr (symbol_attribute *, locus *); ! try gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *); ! try gfc_add_component (gfc_symbol *, const char *, gfc_component **); gfc_symbol *gfc_use_derived (gfc_symbol *); gfc_symtree *gfc_use_derived_tree (gfc_symtree *); ! gfc_component *gfc_find_component (gfc_symbol *, const char *); gfc_st_label *gfc_get_st_label (int); void gfc_free_st_label (gfc_st_label *); void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *); ! try gfc_reference_st_label (gfc_st_label *, gfc_sl_type); gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *); --- 2237,2312 ---- /* symbol.c */ void gfc_clear_new_implicit (void); ! gfc_try gfc_add_new_implicit_range (int, int); ! gfc_try gfc_merge_new_implicit (gfc_typespec *); void gfc_set_implicit_none (void); void gfc_check_function_type (gfc_namespace *); bool gfc_is_intrinsic_typename (const char *); gfc_typespec *gfc_get_default_type (gfc_symbol *, gfc_namespace *); ! gfc_try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *); void gfc_set_sym_referenced (gfc_symbol *); ! gfc_try gfc_add_attribute (symbol_attribute *, locus *); ! gfc_try gfc_add_allocatable (symbol_attribute *, locus *); ! gfc_try gfc_add_dimension (symbol_attribute *, const char *, locus *); ! gfc_try gfc_add_external (symbol_attribute *, locus *); ! gfc_try gfc_add_intrinsic (symbol_attribute *, locus *); ! gfc_try gfc_add_optional (symbol_attribute *, locus *); ! gfc_try gfc_add_pointer (symbol_attribute *, locus *); ! gfc_try gfc_add_cray_pointer (symbol_attribute *, locus *); ! gfc_try gfc_add_cray_pointee (symbol_attribute *, locus *); ! gfc_try gfc_mod_pointee_as (gfc_array_spec *); ! gfc_try gfc_add_protected (symbol_attribute *, const char *, locus *); ! gfc_try gfc_add_result (symbol_attribute *, const char *, locus *); ! gfc_try gfc_add_save (symbol_attribute *, const char *, locus *); ! gfc_try gfc_add_threadprivate (symbol_attribute *, const char *, locus *); ! gfc_try gfc_add_saved_common (symbol_attribute *, locus *); ! gfc_try gfc_add_target (symbol_attribute *, locus *); ! gfc_try gfc_add_dummy (symbol_attribute *, const char *, locus *); ! gfc_try gfc_add_generic (symbol_attribute *, const char *, locus *); ! gfc_try gfc_add_common (symbol_attribute *, locus *); ! gfc_try gfc_add_in_common (symbol_attribute *, const char *, locus *); ! gfc_try gfc_add_in_equivalence (symbol_attribute *, const char *, locus *); ! gfc_try gfc_add_data (symbol_attribute *, const char *, locus *); ! gfc_try gfc_add_in_namelist (symbol_attribute *, const char *, locus *); ! gfc_try gfc_add_sequence (symbol_attribute *, const char *, locus *); ! gfc_try gfc_add_elemental (symbol_attribute *, locus *); ! gfc_try gfc_add_pure (symbol_attribute *, locus *); ! gfc_try gfc_add_recursive (symbol_attribute *, locus *); ! gfc_try gfc_add_function (symbol_attribute *, const char *, locus *); ! gfc_try gfc_add_subroutine (symbol_attribute *, const char *, locus *); ! gfc_try gfc_add_volatile (symbol_attribute *, const char *, locus *); ! gfc_try gfc_add_proc (symbol_attribute *attr, const char *name, locus *where); ! gfc_try gfc_add_abstract (symbol_attribute* attr, locus* where); ! gfc_try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *); ! gfc_try gfc_add_is_bind_c (symbol_attribute *, const char *, locus *, int); ! gfc_try gfc_add_extension (symbol_attribute *, locus *); ! gfc_try gfc_add_value (symbol_attribute *, const char *, locus *); ! gfc_try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *); ! gfc_try gfc_add_entry (symbol_attribute *, const char *, locus *); ! gfc_try gfc_add_procedure (symbol_attribute *, procedure_type, const char *, locus *); ! gfc_try gfc_add_intent (symbol_attribute *, sym_intent, locus *); ! gfc_try gfc_add_explicit_interface (gfc_symbol *, ifsrc, gfc_formal_arglist *, locus *); ! gfc_try gfc_add_type (gfc_symbol *, gfc_typespec *, locus *); void gfc_clear_attr (symbol_attribute *); ! gfc_try gfc_missing_attr (symbol_attribute *, locus *); ! gfc_try gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *); ! gfc_try gfc_add_component (gfc_symbol *, const char *, gfc_component **); gfc_symbol *gfc_use_derived (gfc_symbol *); gfc_symtree *gfc_use_derived_tree (gfc_symtree *); ! gfc_component *gfc_find_component (gfc_symbol *, const char *, bool, bool); gfc_st_label *gfc_get_st_label (int); void gfc_free_st_label (gfc_st_label *); void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *); ! gfc_try gfc_reference_st_label (gfc_st_label *, gfc_sl_type); gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *); *************** gfc_symbol *gfc_new_symbol (const char * *** 2130,2140 **** int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **); int gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **); int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **); ! try verify_c_interop (gfc_typespec *, const char *name, locus *where); ! try verify_c_interop_param (gfc_symbol *); ! try verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *); ! try verify_bind_c_derived_type (gfc_symbol *); ! try verify_com_block_vars_c_interop (gfc_common_head *); void generate_isocbinding_symbol (const char *, iso_c_binding_symbol, const char *); gfc_symbol *get_iso_c_sym (gfc_symbol *, char *, char *, int); int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **); --- 2322,2332 ---- int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **); int gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **); int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **); ! gfc_try verify_c_interop (gfc_typespec *); ! gfc_try verify_c_interop_param (gfc_symbol *); ! gfc_try verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *); ! gfc_try verify_bind_c_derived_type (gfc_symbol *); ! gfc_try verify_com_block_vars_c_interop (gfc_common_head *); void generate_isocbinding_symbol (const char *, iso_c_binding_symbol, const char *); gfc_symbol *get_iso_c_sym (gfc_symbol *, char *, char *, int); int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **); *************** int gfc_symbols_could_alias (gfc_symbol *** 2146,2151 **** --- 2338,2344 ---- void gfc_undo_symbols (void); void gfc_commit_symbols (void); void gfc_commit_symbol (gfc_symbol *); + void gfc_free_charlen (gfc_charlen *, gfc_charlen *); void gfc_free_namespace (gfc_namespace *); void gfc_symbol_init_2 (void); *************** void gfc_symbol_state (void); *** 2161,2168 **** --- 2354,2368 ---- gfc_gsymbol *gfc_get_gsymbol (const char *); gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *); + gfc_symbol* gfc_get_derived_super_type (gfc_symbol*); + gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, gfc_try*, const char*, bool); + void copy_formal_args (gfc_symbol *dest, gfc_symbol *src); + void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.c, too */ + + gfc_try gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus); + /* intrinsic.c */ extern int gfc_init_expr; *************** void gfc_intrinsic_done_1 (void); *** 2177,2187 **** char gfc_type_letter (bt); gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *); ! try gfc_convert_type (gfc_expr *, gfc_typespec *, int); ! try gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int); int gfc_generic_intrinsic (const char *); int gfc_specific_intrinsic (const char *); ! int gfc_intrinsic_name (const char *, int); int gfc_intrinsic_actual_ok (const char *, const bool); gfc_intrinsic_sym *gfc_find_function (const char *); gfc_intrinsic_sym *gfc_find_subroutine (const char *); --- 2377,2388 ---- char gfc_type_letter (bt); gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *); ! gfc_try gfc_convert_type (gfc_expr *, gfc_typespec *, int); ! gfc_try gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int); ! gfc_try gfc_convert_chartype (gfc_expr *, gfc_typespec *); int gfc_generic_intrinsic (const char *); int gfc_specific_intrinsic (const char *); ! bool gfc_is_intrinsic (gfc_symbol*, int, locus); int gfc_intrinsic_actual_ok (const char *, const bool); gfc_intrinsic_sym *gfc_find_function (const char *); gfc_intrinsic_sym *gfc_find_subroutine (const char *); *************** gfc_intrinsic_sym *gfc_find_subroutine ( *** 2189,2194 **** --- 2390,2399 ---- match gfc_intrinsic_func_interface (gfc_expr *, int); match gfc_intrinsic_sub_interface (gfc_code *, int); + void gfc_warn_intrinsic_shadow (const gfc_symbol*, bool, bool); + gfc_try gfc_check_intrinsic_standard (const gfc_intrinsic_sym*, const char**, + bool, locus); + /* match.c -- FIXME */ void gfc_free_iterator (gfc_iterator *, int); void gfc_free_forall_iterator (gfc_forall_iterator *); *************** gfc_expr *gfc_build_conversion (gfc_expr *** 2219,2225 **** void gfc_free_ref_list (gfc_ref *); void gfc_type_convert_binary (gfc_expr *); int gfc_is_constant_expr (gfc_expr *); ! try gfc_simplify_expr (gfc_expr *, int); int gfc_has_vector_index (gfc_expr *); gfc_expr *gfc_get_expr (void); --- 2424,2430 ---- void gfc_free_ref_list (gfc_ref *); void gfc_type_convert_binary (gfc_expr *); int gfc_is_constant_expr (gfc_expr *); ! gfc_try gfc_simplify_expr (gfc_expr *, int); int gfc_has_vector_index (gfc_expr *); gfc_expr *gfc_get_expr (void); *************** gfc_expr *gfc_logical_expr (int, locus * *** 2230,2245 **** mpz_t *gfc_copy_shape (mpz_t *, int); mpz_t *gfc_copy_shape_excluding (mpz_t *, int, gfc_expr *); gfc_expr *gfc_copy_expr (gfc_expr *); ! try gfc_specification_expr (gfc_expr *); int gfc_numeric_ts (gfc_typespec *); int gfc_kind_max (gfc_expr *, gfc_expr *); ! try gfc_check_conformance (const char *, gfc_expr *, gfc_expr *); ! try gfc_check_assign (gfc_expr *, gfc_expr *, int); ! try gfc_check_pointer_assign (gfc_expr *, gfc_expr *); ! try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *); gfc_expr *gfc_default_initializer (gfc_typespec *); gfc_expr *gfc_get_variable_expr (gfc_symtree *); --- 2435,2451 ---- mpz_t *gfc_copy_shape (mpz_t *, int); mpz_t *gfc_copy_shape_excluding (mpz_t *, int, gfc_expr *); gfc_expr *gfc_copy_expr (gfc_expr *); + gfc_ref* gfc_copy_ref (gfc_ref*); ! gfc_try gfc_specification_expr (gfc_expr *); int gfc_numeric_ts (gfc_typespec *); int gfc_kind_max (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_conformance (const char *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_assign (gfc_expr *, gfc_expr *, int); ! gfc_try gfc_check_pointer_assign (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *); gfc_expr *gfc_default_initializer (gfc_typespec *); gfc_expr *gfc_get_variable_expr (gfc_symtree *); *************** bool gfc_traverse_expr (gfc_expr *, gfc_ *** 2248,2253 **** --- 2454,2461 ---- bool (*)(gfc_expr *, gfc_symbol *, int*), int); void gfc_expr_set_symbols_referenced (gfc_expr *); + gfc_try gfc_expr_check_typed (gfc_expr*, gfc_namespace*, bool); + void gfc_expr_replace_symbols (gfc_expr *, gfc_symbol *); /* st.c */ extern gfc_code new_st; *************** void gfc_free_statement (gfc_code *); *** 2259,2274 **** void gfc_free_statements (gfc_code *); /* resolve.c */ ! try gfc_resolve_expr (gfc_expr *); void gfc_resolve (gfc_namespace *); void gfc_resolve_blocks (gfc_code *, gfc_namespace *); int gfc_impure_variable (gfc_symbol *); int gfc_pure (gfc_symbol *); int gfc_elemental (gfc_symbol *); ! try gfc_resolve_iterator (gfc_iterator *, bool); ! try find_forall_index (gfc_expr *, gfc_symbol *, int); ! try gfc_resolve_index (gfc_expr *, int); ! try gfc_resolve_dim_arg (gfc_expr *); int gfc_is_formal_arg (void); void gfc_resolve_substring_charlen (gfc_expr *); match gfc_iso_c_sub_interface(gfc_code *, gfc_symbol *); --- 2467,2482 ---- void gfc_free_statements (gfc_code *); /* resolve.c */ ! gfc_try gfc_resolve_expr (gfc_expr *); void gfc_resolve (gfc_namespace *); void gfc_resolve_blocks (gfc_code *, gfc_namespace *); int gfc_impure_variable (gfc_symbol *); int gfc_pure (gfc_symbol *); int gfc_elemental (gfc_symbol *); ! gfc_try gfc_resolve_iterator (gfc_iterator *, bool); ! gfc_try find_forall_index (gfc_expr *, gfc_symbol *, int); ! gfc_try gfc_resolve_index (gfc_expr *, int); ! gfc_try gfc_resolve_dim_arg (gfc_expr *); int gfc_is_formal_arg (void); void gfc_resolve_substring_charlen (gfc_expr *); match gfc_iso_c_sub_interface(gfc_code *, gfc_symbol *); *************** match gfc_iso_c_sub_interface(gfc_code * *** 2278,2286 **** void gfc_free_array_spec (gfc_array_spec *); gfc_array_ref *gfc_copy_array_ref (gfc_array_ref *); ! try gfc_set_array_spec (gfc_symbol *, gfc_array_spec *, locus *); gfc_array_spec *gfc_copy_array_spec (gfc_array_spec *); ! try gfc_resolve_array_spec (gfc_array_spec *, int); int gfc_compare_array_spec (gfc_array_spec *, gfc_array_spec *); --- 2486,2494 ---- void gfc_free_array_spec (gfc_array_spec *); gfc_array_ref *gfc_copy_array_ref (gfc_array_ref *); ! gfc_try gfc_set_array_spec (gfc_symbol *, gfc_array_spec *, locus *); gfc_array_spec *gfc_copy_array_spec (gfc_array_spec *); ! gfc_try gfc_resolve_array_spec (gfc_array_spec *, int); int gfc_compare_array_spec (gfc_array_spec *, gfc_array_spec *); *************** gfc_expr *gfc_start_constructor (bt, int *** 2288,2353 **** void gfc_append_constructor (gfc_expr *, gfc_expr *); void gfc_free_constructor (gfc_constructor *); void gfc_simplify_iterator_var (gfc_expr *); ! try gfc_expand_constructor (gfc_expr *); int gfc_constant_ac (gfc_expr *); int gfc_expanded_ac (gfc_expr *); ! void gfc_resolve_character_array_constructor (gfc_expr *); ! try gfc_resolve_array_constructor (gfc_expr *); ! try gfc_check_constructor_type (gfc_expr *); ! try gfc_check_iter_variable (gfc_expr *); ! try gfc_check_constructor (gfc_expr *, try (*)(gfc_expr *)); gfc_constructor *gfc_copy_constructor (gfc_constructor *); gfc_expr *gfc_get_array_element (gfc_expr *, int); ! try gfc_array_size (gfc_expr *, mpz_t *); ! try gfc_array_dimen_size (gfc_expr *, int, mpz_t *); ! try gfc_array_ref_shape (gfc_array_ref *, mpz_t *); gfc_array_ref *gfc_find_array_ref (gfc_expr *); void gfc_insert_constructor (gfc_expr *, gfc_constructor *); gfc_constructor *gfc_get_constructor (void); tree gfc_conv_array_initializer (tree type, gfc_expr *); ! try spec_size (gfc_array_spec *, mpz_t *); ! try spec_dimen_size (gfc_array_spec *, int, mpz_t *); int gfc_is_compile_time_shape (gfc_array_spec *); /* 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 *); void gfc_check_interfaces (gfc_namespace *); void gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *); gfc_symbol *gfc_search_interface (gfc_interface *, int, gfc_actual_arglist **); ! try gfc_extend_expr (gfc_expr *); void gfc_free_formal_arglist (gfc_formal_arglist *); ! try gfc_extend_assign (gfc_code *, gfc_namespace *); ! try gfc_add_interface (gfc_symbol *); gfc_interface *gfc_current_interface_head (void); void gfc_set_current_interface_head (gfc_interface *); /* io.c */ extern gfc_st_label format_asterisk; void gfc_free_open (gfc_open *); ! try gfc_resolve_open (gfc_open *); void gfc_free_close (gfc_close *); ! try gfc_resolve_close (gfc_close *); void gfc_free_filepos (gfc_filepos *); ! try gfc_resolve_filepos (gfc_filepos *); void gfc_free_inquire (gfc_inquire *); ! try gfc_resolve_inquire (gfc_inquire *); void gfc_free_dt (gfc_dt *); ! try gfc_resolve_dt (gfc_dt *); /* module.c */ void gfc_module_init_2 (void); void gfc_module_done_2 (void); void gfc_dump_module (const char *, int); bool gfc_check_access (gfc_access, gfc_access); /* primary.c */ symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *); symbol_attribute gfc_expr_attr (gfc_expr *); match gfc_match_rvalue (gfc_expr **); /* trans.c */ void gfc_generate_code (gfc_namespace *); --- 2496,2572 ---- void gfc_append_constructor (gfc_expr *, gfc_expr *); void gfc_free_constructor (gfc_constructor *); void gfc_simplify_iterator_var (gfc_expr *); ! gfc_try gfc_expand_constructor (gfc_expr *); int gfc_constant_ac (gfc_expr *); int gfc_expanded_ac (gfc_expr *); ! gfc_try gfc_resolve_character_array_constructor (gfc_expr *); ! gfc_try gfc_resolve_array_constructor (gfc_expr *); ! gfc_try gfc_check_constructor_type (gfc_expr *); ! gfc_try gfc_check_iter_variable (gfc_expr *); ! gfc_try gfc_check_constructor (gfc_expr *, gfc_try (*)(gfc_expr *)); gfc_constructor *gfc_copy_constructor (gfc_constructor *); gfc_expr *gfc_get_array_element (gfc_expr *, int); ! gfc_try gfc_array_size (gfc_expr *, mpz_t *); ! gfc_try gfc_array_dimen_size (gfc_expr *, int, mpz_t *); ! gfc_try gfc_array_ref_shape (gfc_array_ref *, mpz_t *); gfc_array_ref *gfc_find_array_ref (gfc_expr *); void gfc_insert_constructor (gfc_expr *, gfc_constructor *); gfc_constructor *gfc_get_constructor (void); tree gfc_conv_array_initializer (tree type, gfc_expr *); ! gfc_try spec_size (gfc_array_spec *, mpz_t *); ! gfc_try spec_dimen_size (gfc_array_spec *, int, mpz_t *); int gfc_is_compile_time_shape (gfc_array_spec *); + gfc_try gfc_ref_dimen_size (gfc_array_ref *, int dimen, 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 *); + int gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, int); void gfc_check_interfaces (gfc_namespace *); void gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *); gfc_symbol *gfc_search_interface (gfc_interface *, int, gfc_actual_arglist **); ! gfc_try gfc_extend_expr (gfc_expr *); void gfc_free_formal_arglist (gfc_formal_arglist *); ! gfc_try gfc_extend_assign (gfc_code *, gfc_namespace *); ! gfc_try gfc_add_interface (gfc_symbol *); gfc_interface *gfc_current_interface_head (void); 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*); /* io.c */ extern gfc_st_label format_asterisk; void gfc_free_open (gfc_open *); ! gfc_try gfc_resolve_open (gfc_open *); void gfc_free_close (gfc_close *); ! gfc_try gfc_resolve_close (gfc_close *); void gfc_free_filepos (gfc_filepos *); ! gfc_try gfc_resolve_filepos (gfc_filepos *); void gfc_free_inquire (gfc_inquire *); ! gfc_try gfc_resolve_inquire (gfc_inquire *); void gfc_free_dt (gfc_dt *); ! gfc_try gfc_resolve_dt (gfc_dt *); ! void gfc_free_wait (gfc_wait *); ! gfc_try gfc_resolve_wait (gfc_wait *); /* module.c */ void gfc_module_init_2 (void); void gfc_module_done_2 (void); void gfc_dump_module (const char *, int); bool gfc_check_access (gfc_access, gfc_access); + void gfc_free_use_stmts (gfc_use_list *); /* primary.c */ symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *); symbol_attribute gfc_expr_attr (gfc_expr *); match gfc_match_rvalue (gfc_expr **); + match gfc_match_varspec (gfc_expr*, int, bool); + int gfc_check_digit (char, int); /* trans.c */ void gfc_generate_code (gfc_namespace *); *************** void gfc_insert_bbt (void *, void *, com *** 2359,2386 **** void gfc_delete_bbt (void *, void *, compare_fn); /* dump-parse-tree.c */ ! void gfc_show_actual_arglist (gfc_actual_arglist *); ! void gfc_show_array_ref (gfc_array_ref *); ! void gfc_show_array_spec (gfc_array_spec *); ! void gfc_show_attr (symbol_attribute *); ! void gfc_show_code (int, gfc_code *); ! void gfc_show_components (gfc_symbol *); ! void gfc_show_constructor (gfc_constructor *); ! void gfc_show_equiv (gfc_equiv *); ! void gfc_show_expr (gfc_expr *); ! void gfc_show_expr_n (const char *, gfc_expr *); ! void gfc_show_namelist (gfc_namelist *); ! void gfc_show_namespace (gfc_namespace *); ! void gfc_show_ref (gfc_ref *); ! void gfc_show_symbol (gfc_symbol *); ! void gfc_show_symbol_n (const char *, gfc_symbol *); ! void gfc_show_typespec (gfc_typespec *); /* parse.c */ ! try gfc_parse_file (void); void gfc_global_used (gfc_gsymbol *, locus *); /* dependency.c */ int gfc_dep_compare_expr (gfc_expr *, gfc_expr *); #endif /* GCC_GFORTRAN_H */ --- 2578,2594 ---- void gfc_delete_bbt (void *, void *, compare_fn); /* dump-parse-tree.c */ ! void gfc_dump_parse_tree (gfc_namespace *, FILE *); /* parse.c */ ! gfc_try gfc_parse_file (void); void gfc_global_used (gfc_gsymbol *, locus *); /* dependency.c */ int gfc_dep_compare_expr (gfc_expr *, gfc_expr *); + int gfc_is_data_pointer (gfc_expr *); + + /* check.c */ + gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*); #endif /* GCC_GFORTRAN_H */ diff -Nrcpad gcc-4.3.3/gcc/fortran/gfortran.info gcc-4.4.0/gcc/fortran/gfortran.info *** gcc-4.3.3/gcc/fortran/gfortran.info Sat Jan 24 11:53:16 2009 --- gcc-4.4.0/gcc/fortran/gfortran.info Tue Apr 21 09:55:58 2009 *************** *** 1,15 **** This is doc/gfortran.info, produced by makeinfo version 4.12 from ! /abuild/rguenther/tmp/gcc-4.3.3/gcc-4.3.3/gcc/fortran/gfortran.texi. ! Copyright (C) 1999-2007 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.1 or any later version published by the Free Software Foundation; with the ! Invariant Sections being "GNU General Public License" and "Funding Free ! Software", the Front-Cover texts being (a) (see below), and with the ! Back-Cover Texts being (b) (see below). A copy of the license is ! included in the section entitled "GNU Free Documentation License". (a) The FSF's Front-Cover Text is: --- 1,15 ---- This is doc/gfortran.info, produced by makeinfo version 4.12 from ! /usr/src/gcc-4.4.0/gcc-4.4.0/gcc/fortran/gfortran.texi. ! Copyright (C) 1999-2008 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.2 or any later version published by the Free Software Foundation; with the ! Invariant Sections being "Funding Free Software", the Front-Cover Texts ! being (a) (see below), and with the Back-Cover Texts being (b) (see ! below). A copy of the license is included in the section entitled "GNU ! Free Documentation License". (a) The FSF's Front-Cover Text is: *************** compiler, (`gfortran'). *** 31,45 **** Published by the Free Software Foundation 51 Franklin Street, Fifth Floor Boston, MA 02110-1301 USA ! Copyright (C) 1999-2007 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.1 or any later version published by the Free Software Foundation; with the ! Invariant Sections being "GNU General Public License" and "Funding Free ! Software", the Front-Cover texts being (a) (see below), and with the ! Back-Cover Texts being (b) (see below). A copy of the license is ! included in the section entitled "GNU Free Documentation License". (a) The FSF's Front-Cover Text is: --- 31,45 ---- Published by the Free Software Foundation 51 Franklin Street, Fifth Floor Boston, MA 02110-1301 USA ! Copyright (C) 1999-2008 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.2 or any later version published by the Free Software Foundation; with the ! Invariant Sections being "Funding Free Software", the Front-Cover Texts ! being (a) (see below), and with the Back-Cover Texts being (b) (see ! below). A copy of the license is included in the section entitled "GNU ! Free Documentation License". (a) The FSF's Front-Cover Text is: *************** Part I: Invoking GNU Fortran *** 70,76 **** * Runtime:: Influencing runtime behavior with environment variables. Part II: Language Reference ! * Fortran 2003 status:: Fortran 2003 features supported by GNU Fortran. * Extensions:: Language extensions implemented by GNU Fortran. * Intrinsic Procedures:: Intrinsic procedures supported by GNU Fortran. * Intrinsic Modules:: Intrinsic modules supported by GNU Fortran. --- 70,77 ---- * Runtime:: Influencing runtime behavior with environment variables. Part II: Language Reference ! * Fortran 2003 and 2008 status:: Fortran 2003 and 2008 features supported by GNU Fortran. ! * Compiler Characteristics:: KIND type parameters supported. * Extensions:: Language extensions implemented by GNU Fortran. * Intrinsic Procedures:: Intrinsic procedures supported by GNU Fortran. * Intrinsic Modules:: Intrinsic modules supported by GNU Fortran. *************** Part II: Language Reference *** 79,85 **** * Copying:: GNU General Public License says how you can copy and share GNU Fortran. * GNU Free Documentation License:: ! How you can copy and share this manual. * Funding:: How to help assure continued work for free software. * Option Index:: Index of command line options * Keyword Index:: Index of concepts --- 80,86 ---- * Copying:: GNU General Public License says how you can copy and share GNU Fortran. * GNU Free Documentation License:: ! How you can copy and share this manual. * Funding:: How to help assure continued work for free software. * Option Index:: Index of command line options * Keyword Index:: Index of concepts *************** is the command you'll use to invoke the *** 101,107 **** * Preprocessing and conditional compilation:: The Fortran preprocessor * GNU Fortran and G77:: Why we chose to start from scratch. * Project Status:: Status of GNU Fortran, roadmap, proposed extensions. ! * Standards:: Standards supported by GNU Fortran.  File: gfortran.info, Node: About GNU Fortran, Next: GNU Fortran and GCC, Up: Introduction --- 102,108 ---- * Preprocessing and conditional compilation:: The Fortran preprocessor * GNU Fortran and G77:: Why we chose to start from scratch. * Project Status:: Status of GNU Fortran, roadmap, proposed extensions. ! * Standards:: Standards supported by GNU Fortran.  File: gfortran.info, Node: About GNU Fortran, Next: GNU Fortran and GCC, Up: Introduction *************** remains to be done. *** 117,124 **** expect from any decent compiler: * Read a user's program, stored in a file and containing ! instructions written in Fortran 77, Fortran 90, Fortran 95 or ! Fortran 2003. 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 --- 118,125 ---- expect from any decent compiler: * 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 *************** expect from any decent compiler: *** 126,140 **** "machine code", code designed to be efficiently translated and processed by a machine such as your computer. Humans usually aren't as good writing machine code as they are at writing Fortran ! (or C++, Ada, or Java), because 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. When ! writing Fortran, it is easy to make big mistakes. The Fortran 90 ! requires that the compiler can point out 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 --- 127,141 ---- "machine code", code designed to be efficiently translated and processed by a machine such as your computer. Humans usually aren't 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". The compiler will also attempt to diagnose cases where the user's program contains a correct usage of the language, but instructs *************** the relevant compiler front-end program *** 205,222 **** 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', and `.f03' ! 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', `.F90', `.F95', and `.F03' 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 --- 206,223 ---- 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 *************** code through a C preprocessor (CPP; some *** 236,251 **** 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 file extension is `.F', `.FOR', `.FTN', ! `.F90', `.F95' or `.F03'; otherwise use for fixed-format code the option ! `-x f77-cpp-input' and for free-format code `-x f95-cpp-input'. ! Invocation of the preprocessor can be suppressed using `-x f77' or `-x ! f95'. ! If the GNU Fortran invoked 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 --- 237,257 ---- 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 ! preprocess included files, use the equivalent preprocessor statement ! `#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. While CPP is the de-facto standard for preprocessing Fortran code, Part 3 of the Fortran 95 standard (ISO/IEC 1539-3:1998) defines *************** on it for a while, of course). *** 287,296 **** standard-compliant Fortran 95, Fortran 90, and Fortran 77 programs, including a number of standard and non-standard extensions, and can be used on real-world programs. In particular, the supported extensions ! include OpenMP, Cray-style pointers, and several Fortran 2003 features ! such as enumeration, stream I/O, and some of the enhancements to ! allocatable array support from TR 15581. However, it is still under ! development and has a few remaining rough edges. At present, the GNU Fortran compiler passes the NIST Fortran 77 Test Suite (http://www.fortran-2000.com/ArnaudRecipes/fcvs21_f95.html), and --- 293,302 ---- standard-compliant Fortran 95, Fortran 90, and Fortran 77 programs, including a number of standard and non-standard extensions, and can be used on real-world programs. In particular, the supported extensions ! include OpenMP, Cray-style pointers, and several Fortran 2003 and ! Fortran 2008 features such as enumeration, stream I/O, and some of the ! enhancements to allocatable array support from TR 15581. However, it is ! still under development and has a few remaining rough edges. At present, the GNU Fortran compiler passes the NIST Fortran 77 Test Suite (http://www.fortran-2000.com/ArnaudRecipes/fcvs21_f95.html), and *************** enhancements to allocatable arrays, and *** 330,338 **** Interface v2.5 (http://www.openmp.org/drupal/mp-documents/spec25.pdf) specification. ! In the future, the GNU Fortran compiler may also support other ! standard variants of and extensions to the Fortran language. These ! include ISO/IEC 1539-1:2004 (Fortran 2003).  File: gfortran.info, Node: Invoking GNU Fortran, Next: Runtime, Prev: Introduction, Up: Top --- 336,354 ---- Interface v2.5 (http://www.openmp.org/drupal/mp-documents/spec25.pdf) specification. ! In the future, the GNU Fortran compiler will also support ISO/IEC ! 1539-1:2004 (Fortran 2003) and future Fortran standards. Partial support ! of that standard is already provided; the current status of Fortran 2003 ! support is reported in the *note Fortran 2003 status:: section of the ! documentation. ! ! The next version of the Fortran standard after Fortran 2003 is ! currently being developed and the GNU Fortran compiler supports some of ! its new features. This support is based on the latest draft of the ! standard (available from `http://www.nag.co.uk/sc22wg5/') and no ! guarantee of future compatibility is made, as the final standard might ! differ from the draft. For more information, see the *note Fortran 2008 ! status:: section.  File: gfortran.info, Node: Invoking GNU Fortran, Next: Runtime, Prev: Introduction, Up: Top *************** only one of these two forms, whichever o *** 362,367 **** --- 378,384 ---- without explanations. * Fortran Dialect Options:: Controlling the variant of Fortran language compiled. + * Preprocessing Options:: Enable and customize preprocessing. * Error and Warning Options:: How picky should the compiler be? * Debugging Options:: Symbol tables, measurements, and debugging dumps. * Directory Options:: Where to find module files *************** _Fortran Language Options_ *** 390,403 **** -fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 -fcray-pointer -fopenmp -fno-range-check -fbackslash -fmodule-private _Error and Warning Options_ *Note Options to request or suppress errors and warnings: Error and Warning Options. -fmax-errors=N -fsyntax-only -pedantic -pedantic-errors ! -Wall -Waliasing -Wampersand -Wcharacter-truncation -Wconversion ! -Wimplicit-interface -Wline-truncation -Wnonstd-intrinsics -Wsurprising ! -Wno-tabs -Wunderflow -Wunused-parameter _Debugging Options_ *Note Options for debugging your program or GNU Fortran: Debugging --- 407,429 ---- -fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 -fcray-pointer -fopenmp -fno-range-check -fbackslash -fmodule-private + _Preprocessing Options_ + *Note Enable and customize preprocessing: Preprocessing Options. + -cpp -dD -dI -dM -dN -dU -fworking-directory + -imultilib DIR -iprefix FILE -isysroot DIR + -iquote -isystem DIR -nocpp -nostdinc -undef + -AQUESTION=ANSWER -A-QUESTION[=ANSWER] + -C -CC -DMACRO[=DEFN] -UMACRO -H -P + _Error and Warning Options_ *Note Options to request or suppress errors and warnings: Error and Warning Options. -fmax-errors=N -fsyntax-only -pedantic -pedantic-errors ! -Wall -Waliasing -Wampersand -Warray-bounds -Wcharacter-truncation ! -Wconversion -Wimplicit-interface -Wline-truncation -Wintrinsics-std ! -Wsurprising -Wno-tabs -Wunderflow -Wunused-parameter -Wintrinsics-shadow ! -Wno-align-commons _Debugging Options_ *Note Options for debugging your program or GNU Fortran: Debugging *************** _Debugging Options_ *** 407,413 **** _Directory Options_ *Note Options for directory search: Directory Options. ! -IDIR -JDIR -MDIR -fintrinsic-modules-path DIR _Link Options_ *Note Options for influencing the linking step: Link Options. --- 433,440 ---- _Directory Options_ *Note Options for directory search: Directory Options. ! -IDIR -JDIR -MDIR ! -fintrinsic-modules-path DIR _Link Options_ *Note Options for influencing the linking step: Link Options. *************** _Link Options_ *** 415,438 **** _Runtime Options_ *Note Options for influencing runtime behavior: Runtime Options. ! -fconvert=CONVERSION -frecord-marker=LENGTH ! -fmax-subrecord-length=LENGTH -fsign-zero _Code Generation Options_ *Note Options for code generation conventions: Code Gen Options. -fno-automatic -ff2c -fno-underscoring -fsecond-underscore ! -fbounds-check -fmax-stack-var-size=N -fpack-derived -frepack-arrays -fshort-enums -fexternal-blas -fblas-matmul-limit=N -frecursive -finit-local-zero -finit-integer=N -finit-real= ! -finit-logical= -finit-character=N * Menu: * Fortran Dialect Options:: Controlling the variant of Fortran language compiled. * Error and Warning Options:: How picky should the compiler be? * Debugging Options:: Symbol tables, measurements, and debugging dumps. * Directory Options:: Where to find module files --- 442,468 ---- _Runtime Options_ *Note Options for influencing runtime behavior: Runtime Options. ! -fconvert=CONVERSION -fno-range-check ! -frecord-marker=LENGTH -fmax-subrecord-length=LENGTH ! -fsign-zero _Code Generation Options_ *Note Options for code generation conventions: Code Gen Options. -fno-automatic -ff2c -fno-underscoring -fsecond-underscore ! -fbounds-check -fcheck-array-temporaries -fmax-array-constructor =N ! -fmax-stack-var-size=N -fpack-derived -frepack-arrays -fshort-enums -fexternal-blas -fblas-matmul-limit=N -frecursive -finit-local-zero -finit-integer=N -finit-real= ! -finit-logical= -finit-character=N -fno-align-commons * Menu: * Fortran Dialect Options:: Controlling the variant of Fortran language compiled. + * Preprocessing Options:: Enable and customize preprocessing. * Error and Warning Options:: How picky should the compiler be? * Debugging Options:: Symbol tables, measurements, and debugging dumps. * Directory Options:: Where to find module files *************** _Code Generation Options_ *** 442,448 **** and register usage.  ! File: gfortran.info, Node: Fortran Dialect Options, Next: Error and Warning Options, Prev: Option Summary, Up: Invoking GNU Fortran 2.2 Options controlling Fortran dialect ======================================= --- 472,478 ---- and register usage.  ! File: gfortran.info, Node: Fortran Dialect Options, Next: Preprocessing Options, Prev: Option Summary, Up: Invoking GNU Fortran 2.2 Options controlling Fortran dialect ======================================= *************** accepted by the compiler: *** 459,468 **** source form is determined by the file extension. `-fall-intrinsics' ! Accept all of the intrinsic procedures provided in libgfortran ! without regard to the setting of `-std'. In particular, this ! option can be quite useful with `-std=f95'. Additionally, ! `gfortran' will ignore `-Wnonstd-intrinsics'. `-fd-lines-as-code' --- 489,501 ---- source form is determined by the file extension. `-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 ! with the same name as any intrinsic will be called except when it ! is explicitly declared `EXTERNAL'. `-fd-lines-as-code' *************** accepted by the compiler: *** 474,499 **** comment lines. `-fdefault-double-8' ! Set the `DOUBLE PRECISION' type to an 8 byte wide type. `-fdefault-integer-8' Set the default integer and logical types to an 8 byte wide type. ! Do nothing if this is already the default. `-fdefault-real-8' Set the default real type to an 8 byte wide type. Do nothing if ! this is already the default. `-fdollar-ok' Allow `$' as a valid character in a symbol name. `-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, backspace, form feed, ! newline, carriage return, horizontal tab, vertical tab, backslash, ! and NUL, respectively. All other combinations of a character preceded by \ are unexpanded. `-fmodule-private' --- 507,544 ---- comment lines. `-fdefault-double-8' ! Set the `DOUBLE PRECISION' type to an 8 byte wide type. 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. `-fdefault-integer-8' Set the default integer and logical types to an 8 byte wide type. ! Do nothing if this is already the default. This option also ! affects the kind of integer constants like `42'. `-fdefault-real-8' Set the default real type to an 8 byte wide type. Do nothing if ! this is already the default. 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. `-fdollar-ok' Allow `$' as a valid character in a symbol name. `-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, ! 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 ! digit) are translated into the Unicode characters corresponding to ! the specified code points. All other combinations of a character preceded by \ are unexpanded. `-fmodule-private' *************** accepted by the compiler: *** 523,529 **** `-fmax-identifier-length=N' Specify the maximum allowed identifier length. Typical values are ! 31 (Fortran 95) and 63 (Fortran 2003). `-fimplicit-none' Specify that no implicit typing is allowed, unless overridden by --- 568,574 ---- `-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' Specify that no implicit typing is allowed, unless overridden by *************** accepted by the compiler: *** 556,579 **** `-std=STD' Specify the standard to which the program is expected to conform, ! which may be one of `f95', `f2003', `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 extensions, ! and may be useful for old non-standard programs. The `f95' and ! `f2003' values specify strict conformance to the Fortran 95 and ! Fortran 2003 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.  ! File: gfortran.info, Node: Error and Warning Options, Next: Debugging Options, Prev: Fortran Dialect Options, Up: Invoking GNU Fortran ! 2.3 Options to request or suppress errors and warnings ====================================================== Errors are diagnostic messages that report that the GNU Fortran compiler --- 601,814 ---- `-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 ! 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 ! 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.  ! File: gfortran.info, Node: Preprocessing Options, Next: Error and Warning Options, Prev: Fortran Dialect Options, Up: Invoking GNU Fortran ! 2.3 Enable and customize preprocessing ! ====================================== ! ! 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. ! ! To disable preprocessing of files with any of the above listed ! extensions, use the negative form: `-nocpp'. ! ! The preprocessor is run in traditional mode, be aware that any ! restrictions of the file-format, e.g. fixed-form line width, apply ! for preprocessed output as well. ! ! `-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 ! finding out what is predefined in your version of the preprocessor. ! Assuming you have no file `foo.f90', the command ! touch foo.f90; gfortran -cpp -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 ! standard output file. ! ! `-dN' ! Like `-dD', but emit only the macro names, not their expansions. ! ! `-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 ! undefined at the time. ! ! `-dI' ! Output `'#include'' directives in addition to the result of ! preprocessing. ! ! `-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 ! 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's 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'. ! ! `-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 `'/''. ! ! `-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 ', 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' ! Search DIR for header files, after all directories specified by ! `-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'. ! ! `-nostdinc' ! Do not search the standard system directories for header files. ! Only the directories you have specified with `-I' options (and the ! directory of the current file, if appropriate) are searched. ! ! `-undef' ! Do not predefine any system-specific or GCC-specific macros. The ! standard predefined macros remain defined. ! ! `-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' ! 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. ! ! 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 `'#''. ! ! 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 ! 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. ! ! 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=DEFINITION' ! The contents of DEFINITION are tokenized and processed as if they ! appeared during translation phase three in a `'#define'' directive. ! In particular, the definition will be truncated by embedded newline ! characters. ! ! If you are invoking the preprocessor from a shell or shell-like ! program you may need to use the shell's quoting syntax to protect ! characters such as spaces that have a meaning in the shell syntax. ! ! 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. ! ! `-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' ! 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. ! ! `-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' ! Cancel any previous definition of NAME, either built in or provided ! with a `-D' option. ! !  ! File: gfortran.info, Node: Error and Warning Options, Next: Debugging Options, Prev: Preprocessing Options, Up: Invoking GNU Fortran ! ! 2.4 Options to request or suppress errors and warnings ====================================================== Errors are diagnostic messages that report that the GNU Fortran compiler *************** produced by GNU Fortran: *** 623,629 **** 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' or `-std=f2003'. `-pedantic-errors' Like `-pedantic', except that errors are produced rather than --- 858,865 ---- 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'. `-pedantic-errors' Like `-pedantic', except that errors are produced rather than *************** produced by GNU Fortran: *** 633,639 **** 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', `-Wsurprising', ! `-Wnonstd-intrinsics', `-Wno-tabs', and `-Wline-truncation'. `-Waliasing' Warn about possible aliasing of dummy arguments. Specifically, it --- 869,876 ---- 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', `-Wsurprising', ! `-Wintrinsics-std', `-Wno-tabs', `-Wintrinsic-shadow' and ! `-Wline-truncation'. `-Waliasing' Warn about possible aliasing of dummy arguments. Specifically, it *************** produced by GNU Fortran: *** 654,668 **** `-Wampersand' Warn about missing ampersand in continued character constants. The ! warning is given with `-Wampersand', `-pedantic', `-std=f95', and ! `-std=f2003'. 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. `-Wcharacter-truncation' Warn when a character assignment will truncate the assigned string. `-Wconversion' Warn about implicit conversions between different types. --- 891,913 ---- `-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' ! 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. `-Wcharacter-truncation' Warn when a character assignment will truncate the assigned string. + `-Wline-truncation' + Warn when a source code line will be truncated. + `-Wconversion' Warn about implicit conversions between different types. *************** produced by GNU Fortran: *** 672,680 **** not check that the declared interfaces are consistent across program units. ! `-Wnonstd-intrinsics' ! Warn if the user tries to use an intrinsic that does not belong to ! the standard the user has chosen via the `-std' option. `-Wsurprising' Produce a warning when "suspicious" code constructs are --- 917,928 ---- not check that the declared interfaces are consistent across program units. ! `-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 behaviour and ! always link to the intrinsic regardless of the selected standard. `-Wsurprising' Produce a warning when "suspicious" code constructs are *************** produced by GNU Fortran: *** 692,709 **** * A TRANSFER specifies a source that is shorter than the destination. `-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. `-Wno-tabs' will cause a warning to be issued if a tab is encountered. Note, `-Wno-tabs' is active for `-pedantic', `-std=f95', `-std=f2003', ! and `-Wall'. `-Wunderflow' Produce a warning when numerical constant expressions are encountered, which yield an UNDERFLOW during compilation. `-Wunused-parameter' Contrary to `gcc''s meaning of `-Wunused-parameter', `gfortran''s implementation of this option does not warn about unused dummy --- 940,967 ---- * A TRANSFER specifies a source that is shorter than the destination. + * The type of a function result is declared more than once with + the same type. If `-pedantic' or standard-conforming mode is + enabled, this is an error. + `-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. `-Wno-tabs' will cause a warning to be issued if a tab is encountered. Note, `-Wno-tabs' is active for `-pedantic', `-std=f95', `-std=f2003', ! `-std=f2008' and `-Wall'. `-Wunderflow' Produce a warning when numerical constant expressions are encountered, which yield an UNDERFLOW during compilation. + `-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 + later resolved to the desired intrinsic/procedure. + `-Wunused-parameter' Contrary to `gcc''s meaning of `-Wunused-parameter', `gfortran''s implementation of this option does not warn about unused dummy *************** produced by GNU Fortran: *** 711,716 **** --- 969,980 ---- `-Wunused-parameter' is not included in `-Wall' but is implied by `-Wall -Wextra'. + `-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'. + `-Werror' Turns all warnings into errors. *************** Fortran. *** 724,730 ****  File: gfortran.info, Node: Debugging Options, Next: Directory Options, Prev: Error and Warning Options, Up: Invoking GNU Fortran ! 2.4 Options for debugging your program or GNU Fortran ===================================================== GNU Fortran has various special options that are used for debugging --- 988,994 ----  File: gfortran.info, Node: Debugging Options, Next: Directory Options, Prev: Error and Warning Options, Up: Invoking GNU Fortran ! 2.5 Options for debugging your program or GNU Fortran ===================================================== GNU Fortran has various special options that are used for debugging *************** either your program or the GNU Fortran c *** 747,753 **** and `denormal' (operation produced a denormal value). Some of the routines in the Fortran runtime library, like ! `CPU_TIME', are likely to to trigger floating point exceptions when `ffpe-trap=precision' is used. For this reason, the use of `ffpe-trap=precision' is not recommended. --- 1011,1017 ---- and `denormal' (operation produced a denormal value). Some of the routines in the Fortran runtime library, like ! `CPU_TIME', are likely to trigger floating point exceptions when `ffpe-trap=precision' is used. For this reason, the use of `ffpe-trap=precision' is not recommended. *************** Options, for more information on debuggi *** 770,776 ****  File: gfortran.info, Node: Directory Options, Next: Link Options, Prev: Debugging Options, Up: Invoking GNU Fortran ! 2.5 Options for directory search ================================ These options affect how GNU Fortran searches for files specified by --- 1034,1040 ----  File: gfortran.info, Node: Directory Options, Next: Link Options, Prev: Debugging Options, Up: Invoking GNU Fortran ! 2.6 Options for directory search ================================ These options affect how GNU Fortran searches for files specified by *************** preprocess Fortran source. *** 795,811 **** *Note Options for Directory Search: (gcc)Directory Options, for information on the `-I' option. - `-MDIR' - `-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. The default is the current directory. ! `-J' is an alias for `-M' to avoid conflicts with existing GCC ! options. `-fintrinsic-modules-path DIR' This option specifies the location of pre-compiled intrinsic --- 1059,1074 ---- *Note Options for Directory Search: (gcc)Directory Options, for information on the `-I' option. `-JDIR' + + `-MDIR' 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. The default is the current directory. ! `-M' is deprecated to avoid conflicts with existing GCC options. `-fintrinsic-modules-path DIR' This option specifies the location of pre-compiled intrinsic *************** preprocess Fortran source. *** 815,821 ****  File: gfortran.info, Node: Link Options, Next: Runtime Options, Prev: Directory Options, Up: Invoking GNU Fortran ! 2.6 Influencing the linking step ================================ These options come into play when the compiler links object files into --- 1078,1084 ----  File: gfortran.info, Node: Link Options, Next: Runtime Options, Prev: Directory Options, Up: Invoking GNU Fortran ! 2.7 Influencing the linking step ================================ These options come into play when the compiler links object files into *************** doing a link step. *** 831,837 ****  File: gfortran.info, Node: Runtime Options, Next: Code Gen Options, Prev: Link Options, Up: Invoking GNU Fortran ! 2.7 Influencing runtime behavior ================================ These options affect the runtime behavior of programs compiled with GNU --- 1094,1100 ----  File: gfortran.info, Node: Runtime Options, Next: Code Gen Options, Prev: Link Options, Up: Invoking GNU Fortran ! 2.8 Influencing runtime behavior ================================ These options affect the runtime behavior of programs compiled with GNU *************** Fortran. *** 847,852 **** --- 1110,1123 ---- The `CONVERT' specifier and the GFORTRAN_CONVERT_UNIT environment variable override the default specified by `-fconvert'._ + `-fno-range-check' + Disable range checking of input values during integer `READ' + operations. For example, GNU Fortran will give an error if an + input value is outside of the relevant range of + [`-HUGE()':`HUGE()']. In other words, with `INTEGER (kind=4) :: i' + , attempting to read -2147483648 will give an error unless + `-fno-range-check' is given. + `-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 *************** Fortran. *** 869,875 ****  File: gfortran.info, Node: Code Gen Options, Next: Environment Variables, Prev: Runtime Options, Up: Invoking GNU Fortran ! 2.8 Options for code generation conventions =========================================== These machine-independent options control the interface conventions --- 1140,1146 ----  File: gfortran.info, Node: Code Gen Options, Next: Environment Variables, Prev: Runtime Options, Up: Invoking GNU Fortran ! 2.9 Options for code generation conventions =========================================== These machine-independent options control the interface conventions *************** the other form by either removing `no-' *** 999,1011 **** 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 against the ! actual allocated bounds. Some checks require that `-fbounds-check' is set for the compilation of the main program. ! In the future this may also include other forms of checking, e.g., ! checking substring references. `-fmax-stack-var-size=N' This option specifies the size in bytes of the largest array that --- 1270,1310 ---- 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 against the ! actual allocated bounds and ensures that all string lengths are ! equal for character array constructors without an explicit ! typespec. Some checks require that `-fbounds-check' 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. ! ! `fcheck-array-temporaries' ! 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. ! ! Note: The warning is only printed once per location. ! ! `-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. ! ! `program test' ! `implicit none' ! `integer j' ! `integer, parameter :: n = 100000' ! `integer, parameter :: i(n) = (/ (2*j, j = 1, n) /)' ! `print '(10(I0,1X))', i' ! `end program test' ! ! _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' This option specifies the size in bytes of the largest array that *************** the other form by either removing `no-' *** 1092,1097 **** --- 1391,1407 ---- Note that the `-finit-real=nan' option initializes `REAL' and `COMPLEX' variables with a quiet NaN. + `-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 everywhere, this + padding can cause trouble, and `-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 largests to smallest. + *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. *************** Options, for information on more options *** 1099,1106 ****  File: gfortran.info, Node: Environment Variables, Prev: Code Gen Options, Up: Invoking GNU Fortran ! 2.9 Environment variables affecting `gfortran' ! ============================================== The `gfortran' compiler currently does not make use of any environment variables to control its operation above and beyond those that affect --- 1409,1416 ----  File: gfortran.info, Node: Environment Variables, Prev: Code Gen Options, Up: Invoking GNU Fortran ! 2.10 Environment variables affecting `gfortran' ! =============================================== The `gfortran' compiler currently does not make use of any environment variables to control its operation above and beyond those that affect *************** Variables, for information on environmen *** 1113,1119 **** behavior of programs compiled with GNU Fortran.  ! File: gfortran.info, Node: Runtime, Next: Fortran 2003 status, Prev: Invoking GNU Fortran, Up: Top 3 Runtime: Influencing runtime behavior with environment variables ******************************************************************* --- 1423,1429 ---- 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 ******************************************************************* *************** File: gfortran.info, Node: GFORTRAN_UNB *** 1209,1215 **** ============================================================================== 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. 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. --- 1519,1525 ---- ============================================================================== 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. 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. *************** the same as for the `CONVERT' specifier: *** 1285,1292 **** `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'. --- 1595,1601 ---- `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'. *************** run-time error occurs. To disable the b *** 1351,1360 **** `-fbacktrace' compile option was used.  ! File: gfortran.info, Node: Fortran 2003 status, Next: Extensions, Prev: Runtime, Up: Top ! 4 Fortran 2003 Status ! ********************* Although GNU Fortran focuses on implementing the Fortran 95 standard for the time being, a few Fortran 2003 features are currently available. --- 1660,1680 ---- `-fbacktrace' compile option was used.  ! File: gfortran.info, Node: Fortran 2003 and 2008 status, Next: Compiler Characteristics, Prev: Runtime, Up: Top ! 4 Fortran 2003 and 2008 Status ! ****************************** ! ! * Menu: ! ! * Fortran 2003 status:: ! * Fortran 2008 status:: ! !  ! File: gfortran.info, Node: Fortran 2003 status, Next: Fortran 2008 status, Up: Fortran 2003 and 2008 status ! ! 4.1 Fortran 2003 status ! ======================= Although GNU Fortran focuses on implementing the Fortran 95 standard for the time being, a few Fortran 2003 features are currently available. *************** for the time being, a few Fortran 2003 f *** 1408,1416 ****  ! File: gfortran.info, Node: Extensions, Next: Intrinsic Procedures, Prev: Fortran 2003 status, Up: Top ! 5 Extensions ************ The two sections below detail the extensions to standard Fortran that --- 1728,1804 ----  ! File: gfortran.info, Node: Fortran 2008 status, Prev: Fortran 2003 status, Up: Fortran 2003 and 2008 status ! 4.2 Fortran 2008 status ! ======================= ! ! The next version of the Fortran standard after Fortran 2003 is currently ! being worked on by the Working Group 5 of Sub-Committee 22 of the Joint ! Technical Committee 1 of the International Organization for ! Standardization (ISO) and the International Electrotechnical Commission ! (IEC). This group is known at WG5 (http://www.nag.co.uk/sc22wg5/). The ! next revision of the Fortran standard is informally referred to as ! Fortran 2008, reflecting its planned release year. The GNU Fortran ! compiler has support for some of the new features in Fortran 2008. This ! support is based on the latest draft, available from ! `http://www.nag.co.uk/sc22wg5/'. However, as the final standard may ! differ from the drafts, no guarantee of backward compatibility can be ! made and you should only use it for experimental purposes. ! !  ! File: gfortran.info, Node: Compiler Characteristics, Next: Extensions, Prev: Fortran 2003 and 2008 status, Up: Top ! ! 5 Compiler Characteristics ! ************************** ! ! This chapter describes certain characteristics of the GNU Fortran ! compiler, namely the KIND type parameter values supported. ! ! * Menu: ! ! * KIND Type Parameters:: ! !  ! File: gfortran.info, Node: KIND Type Parameters, Up: Compiler Characteristics ! ! 5.1 KIND Type Parameters ! ======================== ! ! The `KIND' type parameters supported by GNU Fortran for the primitive ! data types are: ! ! `INTEGER' ! 1, 2, 4, 8*, 16*, default: 4 (1) ! ! `LOGICAL' ! 1, 2, 4, 8*, 16*, default: 4 (1) ! ! `REAL' ! 4, 8, 10**, 16**, default: 4 (2) ! ! `COMPLEX' ! 4, 8, 10**, 16**, default: 4 (2) ! ! `CHARACTER' ! 1, 4, default: 1 ! ! ! * = not available on all systems ! ** = not available on all systems; additionally 10 and 16 are never ! available at the same time ! (1) Unless -fdefault-integer-8 is used ! (2) Unless -fdefault-real-8 is used ! ! 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 `SELECT_*_KIND' intrinsics instead of the concrete values. ! !  ! File: gfortran.info, Node: Extensions, Next: Intrinsic Procedures, Prev: Compiler Characteristics, Up: Top ! ! 6 Extensions ************ The two sections below detail the extensions to standard Fortran that *************** extensions. *** 1428,1434 ****  File: gfortran.info, Node: Extensions implemented in GNU Fortran, Next: Extensions not implemented in GNU Fortran, Up: Extensions ! 5.1 Extensions implemented in GNU Fortran ========================================= GNU Fortran implements a number of extensions over standard Fortran. --- 1816,1822 ----  File: gfortran.info, Node: Extensions implemented in GNU Fortran, Next: Extensions not implemented in GNU Fortran, Up: Extensions ! 6.1 Extensions implemented in GNU Fortran ========================================= GNU Fortran implements a number of extensions over standard Fortran. *************** provide functionality beyond that provid *** 1438,1445 **** 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' or `-std=f2003' disables both ! types of extensions, and `-std=legacy' allows both without warning. * Menu: --- 1826,1834 ---- 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. * Menu: *************** types of extensions, and `-std=legacy' a *** 1463,1469 ****  File: gfortran.info, Node: Old-style kind specifications, Next: Old-style variable initialization, Up: Extensions implemented in GNU Fortran ! 5.1.1 Old-style kind specifications ----------------------------------- GNU Fortran allows old-style kind specifications in declarations. These --- 1852,1858 ----  File: gfortran.info, Node: Old-style kind specifications, Next: Old-style variable initialization, Up: Extensions implemented in GNU Fortran ! 6.1.1 Old-style kind specifications ----------------------------------- GNU Fortran allows old-style kind specifications in declarations. These *************** total size of the real and imaginary par *** 1476,1488 **** 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 equal to `size' for most types, but is equal to ! `size/2' for the `COMPLEX' type.  File: gfortran.info, Node: Old-style variable initialization, Next: Extensions to namelist, Prev: Old-style kind specifications, Up: Extensions implemented in GNU Fortran ! 5.1.2 Old-style variable initialization --------------------------------------- GNU Fortran allows old-style initialization of variables of the form: --- 1865,1881 ---- 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: ! INTEGER, PARAMETER :: dbl = KIND(1.0d0) ! REAL(KIND=dbl) :: x  File: gfortran.info, Node: Old-style variable initialization, Next: Extensions to namelist, Prev: Old-style kind specifications, Up: Extensions implemented in GNU Fortran ! 6.1.2 Old-style variable initialization --------------------------------------- GNU Fortran allows old-style initialization of variables of the form: *************** or in `DATA' statements automatically ac *** 1513,1519 ****  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 ! 5.1.3 Extensions to namelist ---------------------------- GNU Fortran fully supports the Fortran 95 standard for namelist I/O --- 1906,1912 ----  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 ! 6.1.3 Extensions to namelist ---------------------------- GNU Fortran fully supports the Fortran 95 standard for namelist I/O *************** be given the values 1.00 and 2.00. *** 1574,1580 ****  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 ! 5.1.4 `X' format descriptor without count field ----------------------------------------------- To support legacy codes, GNU Fortran permits the count field of the `X' --- 1967,1973 ----  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 ----------------------------------------------- To support legacy codes, GNU Fortran permits the count field of the `X' *************** the count is implicitly assumed to be on *** 1587,1593 ****  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 ! 5.1.5 Commas in `FORMAT' specifications --------------------------------------- To support legacy codes, GNU Fortran allows the comma separator to be --- 1980,1986 ----  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 --------------------------------------- To support legacy codes, GNU Fortran allows the comma separator to be *************** in `FORMAT' statements. *** 1600,1606 ****  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 ! 5.1.6 Missing period in `FORMAT' specifications ----------------------------------------------- To support legacy codes, GNU Fortran allows missing periods in format --- 1993,1999 ----  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 ----------------------------------------------- To support legacy codes, GNU Fortran allows missing periods in format *************** line. This is considered non-conforming *** 1614,1620 ****  File: gfortran.info, Node: I/O item lists, Next: BOZ literal constants, Prev: Missing period in FORMAT specifications, Up: Extensions implemented in GNU Fortran ! 5.1.7 I/O item lists -------------------- To support legacy codes, GNU Fortran allows the input item list of the --- 2007,2013 ----  File: gfortran.info, Node: I/O item lists, Next: BOZ literal constants, 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 *************** statements, to start with a comma. *** 1624,1630 ****  File: gfortran.info, Node: BOZ literal constants, Next: Real array indices, Prev: I/O item lists, Up: Extensions implemented in GNU Fortran ! 5.1.8 BOZ literal constants --------------------------- Besides decimal constants, Fortran also supports binary (`b'), octal --- 2017,2023 ----  File: gfortran.info, Node: BOZ literal constants, Next: Real array indices, Prev: I/O item lists, Up: Extensions implemented in GNU Fortran ! 6.1.8 BOZ literal constants --------------------------- Besides decimal constants, Fortran also supports binary (`b'), octal *************** manner. *** 1671,1677 ****  File: gfortran.info, Node: Real array indices, Next: Unary operators, Prev: BOZ literal constants, Up: Extensions implemented in GNU Fortran ! 5.1.9 Real array indices ------------------------ As an extension, GNU Fortran allows the use of `REAL' expressions or --- 2064,2070 ----  File: gfortran.info, Node: Real array indices, Next: Unary operators, Prev: BOZ literal constants, Up: Extensions implemented in GNU Fortran ! 6.1.9 Real array indices ------------------------ As an extension, GNU Fortran allows the use of `REAL' expressions or *************** variables as array indices. *** 1680,1686 ****  File: gfortran.info, Node: Unary operators, Next: Implicitly convert LOGICAL and INTEGER values, Prev: Real array indices, Up: Extensions implemented in GNU Fortran ! 5.1.10 Unary operators ---------------------- As an extension, GNU Fortran allows unary plus and unary minus operators --- 2073,2079 ----  File: gfortran.info, Node: Unary operators, Next: Implicitly convert LOGICAL and INTEGER values, Prev: Real array indices, Up: Extensions implemented in GNU Fortran ! 6.1.10 Unary operators ---------------------- As an extension, GNU Fortran allows unary plus and unary minus operators *************** the need for parenthesis. *** 1692,1698 ****  File: gfortran.info, Node: Implicitly convert LOGICAL and INTEGER values, Next: Hollerith constants support, Prev: Unary operators, Up: Extensions implemented in GNU Fortran ! 5.1.11 Implicitly convert `LOGICAL' and `INTEGER' values -------------------------------------------------------- As an extension for backwards compatibility with other compilers, GNU --- 2085,2091 ----  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.11 Implicitly convert `LOGICAL' and `INTEGER' values -------------------------------------------------------- As an extension for backwards compatibility with other compilers, GNU *************** interpreted as `.TRUE.'. *** 1715,1721 ****  File: gfortran.info, Node: Hollerith constants support, Next: Cray pointers, Prev: Implicitly convert LOGICAL and INTEGER values, Up: Extensions implemented in GNU Fortran ! 5.1.12 Hollerith constants support ---------------------------------- GNU Fortran supports Hollerith constants in assignments, function --- 2108,2114 ----  File: gfortran.info, Node: Hollerith constants support, Next: Cray pointers, Prev: Implicitly convert LOGICAL and INTEGER values, Up: Extensions implemented in GNU Fortran ! 6.1.12 Hollerith constants support ---------------------------------- GNU Fortran supports Hollerith constants in assignments, function *************** obtained by using the `TRANSFER' stateme *** 1751,1757 ****  File: gfortran.info, Node: Cray pointers, Next: CONVERT specifier, Prev: Hollerith constants support, Up: Extensions implemented in GNU Fortran ! 5.1.13 Cray pointers -------------------- Cray pointers are part of a non-standard extension that provides a --- 2144,2150 ----  File: gfortran.info, Node: Cray pointers, Next: CONVERT specifier, Prev: Hollerith constants support, Up: Extensions implemented in GNU Fortran ! 6.1.13 Cray pointers -------------------- Cray pointers are part of a non-standard extension that provides a *************** will not change the base address of the *** 1865,1871 ****  File: gfortran.info, Node: CONVERT specifier, Next: OpenMP, Prev: Cray pointers, Up: Extensions implemented in GNU Fortran ! 5.1.14 `CONVERT' specifier -------------------------- GNU Fortran allows the conversion of unformatted data between little- --- 2258,2264 ----  File: gfortran.info, Node: CONVERT specifier, Next: OpenMP, Prev: Cray pointers, Up: Extensions implemented in GNU Fortran ! 6.1.14 `CONVERT' specifier -------------------------- GNU Fortran allows the conversion of unformatted data between little- *************** variable. *** 1880,1890 **** `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 ! unformatted files. Using the option could look like this: open(file='big.dat',form='unformatted',access='sequential', & --- 2273,2283 ---- `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 ! unformatted files. Using the option could look like this: open(file='big.dat',form='unformatted',access='sequential', & *************** you, it is best if you use this only for *** 1912,1918 ****  File: gfortran.info, Node: OpenMP, Next: Argument list functions, Prev: CONVERT specifier, Up: Extensions implemented in GNU Fortran ! 5.1.15 OpenMP ------------- OpenMP (Open Multi-Processing) is an application programming interface --- 2305,2311 ----  File: gfortran.info, Node: OpenMP, Next: Argument list functions, Prev: CONVERT specifier, Up: Extensions implemented in GNU Fortran ! 6.1.15 OpenMP ------------- OpenMP (Open Multi-Processing) is an application programming interface *************** OpenMP Application Program Interface v2. *** 1950,1956 **** 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. --- 2343,2349 ---- 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. *************** OpenMP Application Program Interface v2. *** 1965,1971 ****  File: gfortran.info, Node: Argument list functions, Prev: OpenMP, Up: Extensions implemented in GNU Fortran ! 5.1.16 Argument list functions `%VAL', `%REF' and `%LOC' -------------------------------------------------------- GNU Fortran supports argument list functions `%VAL', `%REF' and `%LOC' --- 2358,2364 ----  File: gfortran.info, Node: Argument list functions, Prev: OpenMP, Up: Extensions implemented in GNU Fortran ! 6.1.16 Argument list functions `%VAL', `%REF' and `%LOC' -------------------------------------------------------- GNU Fortran supports argument list functions `%VAL', `%REF' and `%LOC' *************** are worth a look. *** 2003,2017 ****  File: gfortran.info, Node: Extensions not implemented in GNU Fortran, Prev: Extensions implemented in GNU Fortran, Up: Extensions ! 5.2 Extensions not implemented in GNU Fortran ============================================= The long history of the Fortran language, its wide use and broad userbase, the large number of different compiler vendors and the lack of some features crucial to users in the first standards have lead to the ! existence of an important number of 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. --- 2396,2410 ----  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 ============================================= The long history of the Fortran language, its wide use and broad userbase, the large number of different compiler vendors and the lack of 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. *************** best make code that uses them running wi *** 2023,2029 ****  File: gfortran.info, Node: STRUCTURE and RECORD, Next: ENCODE and DECODE statements, Up: Extensions not implemented in GNU Fortran ! 5.2.1 `STRUCTURE' and `RECORD' ------------------------------ Structures are user-defined aggregate data types; this functionality was --- 2416,2422 ----  File: gfortran.info, Node: STRUCTURE and RECORD, Next: ENCODE and DECODE statements, Up: Extensions not implemented in GNU Fortran ! 6.2.1 `STRUCTURE' and `RECORD' ------------------------------ Structures are user-defined aggregate data types; this functionality was *************** structure syntax: *** 2051,2057 **** store_catalog(7).description = "milk bottle" store_catalog(7).price = 1.2 ! ! We can also manipulates the whole structure store_catalog(12) = pear print *, store_catalog(12) --- 2444,2450 ---- store_catalog(7).description = "milk bottle" store_catalog(7).price = 1.2 ! ! We can also manipulate the whole structure store_catalog(12) = pear print *, store_catalog(12) *************** This code can easily be rewritten in the *** 2084,2090 ****  File: gfortran.info, Node: ENCODE and DECODE statements, Prev: STRUCTURE and RECORD, Up: Extensions not implemented in GNU Fortran ! 5.2.2 `ENCODE' and `DECODE' statements -------------------------------------- GNU Fortran doesn't support the `ENCODE' and `DECODE' statements. --- 2477,2483 ----  File: gfortran.info, Node: ENCODE and DECODE statements, Prev: STRUCTURE and RECORD, Up: Extensions not implemented in GNU Fortran ! 6.2.2 `ENCODE' and `DECODE' statements -------------------------------------- GNU Fortran doesn't support the `ENCODE' and `DECODE' statements. *************** with the following: *** 2126,2132 ****  File: gfortran.info, Node: Intrinsic Procedures, Next: Intrinsic Modules, Prev: Extensions, Up: Top ! 6 Intrinsic Procedures ********************** * Menu: --- 2519,2525 ----  File: gfortran.info, Node: Intrinsic Procedures, Next: Intrinsic Modules, Prev: Extensions, Up: Top ! 7 Intrinsic Procedures ********************** * Menu: *************** File: gfortran.info, Node: Intrinsic Pr *** 2154,2165 **** * `ATAN': ATAN, Arctangent function * `ATAN2': ATAN2, Arctangent function * `ATANH': ATANH, Hyperbolic arctangent function ! * `BESJ0': BESJ0, Bessel function of the first kind of order 0 ! * `BESJ1': BESJ1, Bessel function of the first kind of order 1 ! * `BESJN': BESJN, Bessel function of the first kind ! * `BESY0': BESY0, Bessel function of the second kind of order 0 ! * `BESY1': BESY1, Bessel function of the second kind of order 1 ! * `BESYN': BESYN, Bessel function of the second kind * `BIT_SIZE': BIT_SIZE, Bit size inquiry function * `BTEST': BTEST, Bit test function * `C_ASSOCIATED': C_ASSOCIATED, Status of a C pointer --- 2547,2558 ---- * `ATAN': ATAN, Arctangent function * `ATAN2': ATAN2, Arctangent function * `ATANH': ATANH, Hyperbolic arctangent function ! * `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 * `BIT_SIZE': BIT_SIZE, Bit size inquiry function * `BTEST': BTEST, Bit test function * `C_ASSOCIATED': C_ASSOCIATED, Status of a C pointer *************** File: gfortran.info, Node: Intrinsic Pr *** 2167,2172 **** --- 2560,2566 ---- * `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 *************** File: gfortran.info, Node: Intrinsic Pr *** 2195,2200 **** --- 2589,2595 ---- * `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) * `EXIT': EXIT, Exit the program with status. * `EXP': EXP, Exponential function *************** File: gfortran.info, Node: Intrinsic Pr *** 2228,2233 **** --- 2623,2629 ---- * `GMTIME': GMTIME, Convert time to GMT info * `HOSTNM': HOSTNM, Get system host name * `HUGE': HUGE, Largest number of a kind + * `HYPOT': HYPOT, Euclidian distance function * `IACHAR': IACHAR, Code in ASCII collating sequence * `IAND': IAND, Bitwise logical and * `IARGC': IARGC, Get the number of command line arguments *************** File: gfortran.info, Node: Intrinsic Pr *** 2254,2262 **** * `KILL': KILL, Send a signal to a process * `KIND': KIND, Kind of an entity * `LBOUND': LBOUND, Lower dimension bounds of an array * `LEN': LEN, Length of a character entity * `LEN_TRIM': LEN_TRIM, Length of a character entity without trailing blank characters ! * `LGAMMA': LGAMMA, Logarithm of the Gamma function * `LGE': LGE, Lexical greater than or equal * `LGT': LGT, Lexical greater than * `LINK': LINK, Create a hard link --- 2650,2659 ---- * `KILL': KILL, Send a signal to a process * `KIND': KIND, Kind of an entity * `LBOUND': LBOUND, Lower dimension 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 ! * `LOG_GAMMA': LOG_GAMMA, Logarithm of the Gamma function * `LGE': LGE, Lexical greater than or equal * `LGT': LGT, Lexical greater than * `LINK': LINK, Create a hard link *************** File: gfortran.info, Node: Intrinsic Pr *** 2303,2309 **** * `RANDOM_NUMBER': RANDOM_NUMBER, Pseudo-random number * `RANDOM_SEED': RANDOM_SEED, Initialize a pseudo-random number sequence * `RAND': RAND, Real pseudo-random number ! * `RANGE': RANGE, Decimal exponent range of a real kind * `RAN': RAN, Real pseudo-random number * `REAL': REAL, Convert to real type * `RENAME': RENAME, Rename a file --- 2700,2706 ---- * `RANDOM_NUMBER': RANDOM_NUMBER, Pseudo-random number * `RANDOM_SEED': RANDOM_SEED, Initialize a pseudo-random number sequence * `RAND': RAND, Real pseudo-random number ! * `RANGE': RANGE, Decimal exponent range * `RAN': RAN, Real pseudo-random number * `REAL': REAL, Convert to real type * `RENAME': RENAME, Rename a file *************** File: gfortran.info, Node: Intrinsic Pr *** 2315,2320 **** --- 2712,2718 ---- * `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 *************** File: gfortran.info, Node: Intrinsic Pr *** 2341,2346 **** --- 2739,2745 ---- * `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 *************** File: gfortran.info, Node: Intrinsic Pr *** 2355,2370 ****  File: gfortran.info, Node: Introduction to Intrinsics, Next: ABORT, Up: Intrinsic Procedures ! 6.1 Introduction to intrinsic procedures ======================================== The intrinsic procedures provided by GNU Fortran include all of the intrinsic procedures required by the Fortran 95 standard, a set of ! intrinsic procedures for backwards compatibility with G77, and a small ! selection of intrinsic procedures from the Fortran 2003 standard. Any ! conflict between a description here and a description in either the ! Fortran 95 standard or the Fortran 2003 standard is unintentional, and ! the standard(s) should be considered authoritative. The enumeration of the `KIND' type parameter is processor defined in the Fortran 95 standard. GNU Fortran defines the default integer type --- 2754,2770 ----  File: gfortran.info, Node: Introduction to Intrinsics, Next: ABORT, Up: Intrinsic Procedures ! 7.1 Introduction to intrinsic procedures ======================================== The intrinsic procedures provided by GNU Fortran include all of the intrinsic procedures required by the Fortran 95 standard, a set of ! intrinsic procedures for backwards compatibility with G77, and a ! selection of intrinsic procedures from the Fortran 2003 and Fortran 2008 ! standards. Any conflict between a description here and a description in ! either the Fortran 95 standard, the Fortran 2003 standard or the Fortran ! 2008 standard is unintentional, and the standard(s) should be considered ! authoritative. The enumeration of the `KIND' type parameter is processor defined in the Fortran 95 standard. GNU Fortran defines the default integer type *************** for each intrinsic procedure is noted. *** 2397,2409 ****  File: gfortran.info, Node: ABORT, Next: ABS, Prev: Introduction to Intrinsics, Up: Intrinsic Procedures ! 6.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, ! which is suitable for debugging purposes. _Standard_: GNU extension --- 2797,2810 ----  File: gfortran.info, Node: ABORT, Next: ABS, Prev: Introduction to Intrinsics, Up: Intrinsic Procedures ! 7.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 ! even if the option `-fno-dump-core' is in effect, which is ! suitable for debugging purposes. _Standard_: GNU extension *************** _See also_: *** 2430,2457 ****  File: gfortran.info, Node: ABS, Next: ACCESS, Prev: ABORT, Up: Intrinsic Procedures ! 6.3 `ABS' -- Absolute value =========================== _Description_: ! `ABS(X)' computes the absolute value of `X'. _Standard_: ! F77 and later, has overloads that are GNU extensions _Class_: Elemental function _Syntax_: ! `RESULT = ABS(X)' _Arguments_: ! X 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. _Example_: program test_abs --- 2831,2858 ----  File: gfortran.info, Node: ABS, Next: ACCESS, Prev: ABORT, Up: Intrinsic Procedures ! 7.3 `ABS' -- Absolute value =========================== _Description_: ! `ABS(A)' computes the absolute value of `A'. _Standard_: ! Fortran 77 and later, has overloads that are GNU extensions _Class_: Elemental function _Syntax_: ! `RESULT = ABS(A)' _Arguments_: ! 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. _Example_: program test_abs *************** _Example_: *** 2465,2485 **** _Specific names_: Name Argument Return type Standard ! `CABS(Z)' `COMPLEX(4) `REAL(4)' F77 and later ! Z' ! `DABS(X)' `REAL(8) `REAL(8)' F77 and later ! X' ! `IABS(I)' `INTEGER(4) `INTEGER(4)' F77 and later ! I' ! `ZABS(Z)' `COMPLEX(8) `COMPLEX(8)' GNU extension Z' ! `CDABS(Z)' `COMPLEX(8) `COMPLEX(8)' GNU extension Z'  File: gfortran.info, Node: ACCESS, Next: ACHAR, Prev: ABS, Up: Intrinsic Procedures ! 6.4 `ACCESS' -- Checks file access modes ======================================== _Description_: --- 2866,2886 ---- _Specific names_: Name Argument Return type Standard ! `CABS(A)' `COMPLEX(4) `REAL(4)' Fortran 77 and ! Z' later ! `DABS(A)' `REAL(8) `REAL(8)' Fortran 77 and ! X' later ! `IABS(A)' `INTEGER(4) `INTEGER(4)' Fortran 77 and ! I' later ! `ZABS(A)' `COMPLEX(8) `COMPLEX(8)' GNU extension Z' ! `CDABS(A)' `COMPLEX(8) `COMPLEX(8)' GNU extension Z'  File: gfortran.info, Node: ACCESS, Next: ACHAR, Prev: ABS, Up: Intrinsic Procedures ! 7.4 `ACCESS' -- Checks file access modes ======================================== _Description_: *************** _Syntax_: *** 2497,2511 **** `RESULT = ACCESS(NAME, MODE)' _Arguments_: ! NAME Scalar `CHARACTER' 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' 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 --- 2898,2912 ---- `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. _Return value_: Returns a scalar `INTEGER', which is `0' if the file is accessible *************** _See also_: *** 2532,2538 ****  File: gfortran.info, Node: ACHAR, Next: ACOS, Prev: ACCESS, Up: Intrinsic Procedures ! 6.5 `ACHAR' -- Character in ASCII collating sequence ==================================================== _Description_: --- 2933,2939 ----  File: gfortran.info, Node: ACHAR, Next: ACOS, Prev: ACCESS, Up: Intrinsic Procedures ! 7.5 `ACHAR' -- Character in ASCII collating sequence ==================================================== _Description_: *************** _Description_: *** 2540,2559 **** ASCII collating sequence. _Standard_: ! F77 and later _Class_: Elemental function _Syntax_: ! `RESULT = ACHAR(I)' _Arguments_: ! I The type shall be `INTEGER(*)'. _Return value_: ! The return value is of type `CHARACTER' with a length of one. The ! kind type parameter is the same as `KIND('A')'. _Example_: program test_achar --- 2941,2964 ---- ASCII collating sequence. _Standard_: ! Fortran 77 and later, with KIND argument Fortran 2003 and later _Class_: Elemental function _Syntax_: ! `RESULT = ACHAR(I [, KIND])' _Arguments_: ! 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 KIND argument is present, the return value is of the specified ! kind and of the default kind otherwise. _Example_: program test_achar *************** _See also_: *** 2572,2585 ****  File: gfortran.info, Node: ACOS, Next: ACOSH, Prev: ACHAR, Up: Intrinsic Procedures ! 6.6 `ACOS' -- Arccosine function ================================ _Description_: `ACOS(X)' computes the arccosine of X (inverse of `COS(X)'). _Standard_: ! F77 and later _Class_: Elemental function --- 2977,2990 ----  File: gfortran.info, Node: ACOS, Next: ACOSH, Prev: ACHAR, Up: Intrinsic Procedures ! 7.6 `ACOS' -- Arccosine function ================================ _Description_: `ACOS(X)' computes the arccosine of X (inverse of `COS(X)'). _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Syntax_: *** 2588,2599 **** `RESULT = ACOS(X)' _Arguments_: ! X The type shall be `REAL(*)' with a magnitude ! that is less than one. _Return value_: ! The return value is of type `REAL(*)' and it lies in the range 0 ! \leq \acos(x) \leq \pi. The kind type parameter is the same as X. _Example_: program test_acos --- 2993,3004 ---- `RESULT = ACOS(X)' _Arguments_: ! X The type shall be `REAL' with a magnitude that ! is less than or equal to one. _Return value_: ! The return value is of type `REAL' and it lies in the range 0 ! \leq \acos(x) \leq \pi. The return value if of the same kind as X. _Example_: program test_acos *************** _Example_: *** 2603,2609 **** _Specific names_: Name Argument Return type Standard ! `DACOS(X)' `REAL(8) X' `REAL(8)' F77 and later _See also_: Inverse function: *note COS:: --- 3008,3015 ---- _Specific names_: Name Argument Return type Standard ! `DACOS(X)' `REAL(8) X' `REAL(8)' Fortran 77 and ! later _See also_: Inverse function: *note COS:: *************** _See also_: *** 2612,2618 ****  File: gfortran.info, Node: ACOSH, Next: ADJUSTL, Prev: ACOS, Up: Intrinsic Procedures ! 6.7 `ACOSH' -- Hyperbolic arccosine function ============================================ _Description_: --- 3018,3024 ----  File: gfortran.info, Node: ACOSH, Next: ADJUSTL, Prev: ACOS, Up: Intrinsic Procedures ! 7.7 `ACOSH' -- Hyperbolic arccosine function ============================================ _Description_: *************** _Description_: *** 2620,2626 **** `COSH(X)'). _Standard_: ! GNU extension _Class_: Elemental function --- 3026,3032 ---- `COSH(X)'). _Standard_: ! Fortran 2008 and later _Class_: Elemental function *************** _Syntax_: *** 2629,2640 **** `RESULT = ACOSH(X)' _Arguments_: ! X The type shall be `REAL(*)' with a magnitude ! that is greater or equal to one. _Return value_: ! The return value is of type `REAL(*)' and it lies in the range 0 ! \leq \acosh (x) \leq \infty. _Example_: PROGRAM test_acosh --- 3035,3044 ---- `RESULT = ACOSH(X)' _Arguments_: ! X The type shall be `REAL' or `COMPLEX'. _Return value_: ! The return value has the same type and kind as X _Example_: PROGRAM test_acosh *************** _See also_: *** 2652,2680 ****  File: gfortran.info, Node: ADJUSTL, Next: ADJUSTR, Prev: ACOSH, Up: Intrinsic Procedures ! 6.8 `ADJUSTL' -- Left adjust a string ===================================== _Description_: ! `ADJUSTL(STR)' will left adjust a string by removing leading spaces. Spaces are inserted at the end of the string as needed. _Standard_: ! F95 and later _Class_: Elemental function _Syntax_: ! `RESULT = ADJUSTL(STR)' _Arguments_: ! STR The type shall be `CHARACTER'. _Return value_: ! The return value is of type `CHARACTER' where leading spaces are ! removed and the same number of spaces are inserted on the end of ! STR. _Example_: program test_adjustl --- 3056,3084 ----  File: gfortran.info, Node: ADJUSTL, Next: ADJUSTR, Prev: ACOSH, Up: Intrinsic Procedures ! 7.8 `ADJUSTL' -- Left adjust a string ===================================== _Description_: ! `ADJUSTL(STRING)' will left adjust a string by removing leading spaces. Spaces are inserted at the end of the string as needed. _Standard_: ! Fortran 90 and later _Class_: Elemental function _Syntax_: ! `RESULT = ADJUSTL(STRING)' _Arguments_: ! STRING The type shall be `CHARACTER'. _Return value_: ! 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. _Example_: program test_adjustl *************** _See also_: *** 2689,2717 ****  File: gfortran.info, Node: ADJUSTR, Next: AIMAG, Prev: ADJUSTL, Up: Intrinsic Procedures ! 6.9 `ADJUSTR' -- Right adjust a string ====================================== _Description_: ! `ADJUSTR(STR)' will right adjust a string by removing trailing spaces. Spaces are inserted at the start of the string as needed. _Standard_: ! F95 and later _Class_: Elemental function _Syntax_: ! `RESULT = ADJUSTR(STR)' _Arguments_: STR The type shall be `CHARACTER'. _Return value_: ! The return value is of type `CHARACTER' where trailing spaces are ! removed and the same number of spaces are inserted at the start of ! STR. _Example_: program test_adjustr --- 3093,3121 ----  File: gfortran.info, Node: ADJUSTR, Next: AIMAG, Prev: ADJUSTL, Up: Intrinsic Procedures ! 7.9 `ADJUSTR' -- Right adjust a string ====================================== _Description_: ! `ADJUSTR(STRING)' will right adjust a string by removing trailing spaces. Spaces are inserted at the start of the string as needed. _Standard_: ! Fortran 95 and later _Class_: Elemental function _Syntax_: ! `RESULT = ADJUSTR(STRING)' _Arguments_: STR The type shall be `CHARACTER'. _Return value_: ! 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. _Example_: program test_adjustr *************** _See also_: *** 2726,2732 ****  File: gfortran.info, Node: AIMAG, Next: AINT, Prev: ADJUSTR, Up: Intrinsic Procedures ! 6.10 `AIMAG' -- Imaginary part of complex number ================================================ _Description_: --- 3130,3136 ----  File: gfortran.info, Node: AIMAG, Next: AINT, Prev: ADJUSTR, Up: Intrinsic Procedures ! 7.10 `AIMAG' -- Imaginary part of complex number ================================================ _Description_: *************** _Description_: *** 2736,2742 **** discouraged. _Standard_: ! F77 and later, has overloads that are GNU extensions _Class_: Elemental function --- 3140,3146 ---- discouraged. _Standard_: ! Fortran 77 and later, has overloads that are GNU extensions _Class_: Elemental function *************** _Syntax_: *** 2745,2754 **** `RESULT = AIMAG(Z)' _Arguments_: ! 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 argument. _Example_: --- 3149,3158 ---- `RESULT = AIMAG(Z)' _Arguments_: ! 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 argument. _Example_: *************** _Specific names_: *** 2764,2806 **** Name Argument Return type Standard `DIMAG(Z)' `COMPLEX(8) `REAL(8)' GNU extension Z' ! `IMAG(Z)' `COMPLEX(*) `REAL(*)' GNU extension ! Z' ! `IMAGPART(Z)' `COMPLEX(*) `REAL(*)' GNU extension ! Z'  File: gfortran.info, Node: AINT, Next: ALARM, Prev: AIMAG, Up: Intrinsic Procedures ! 6.11 `AINT' -- Truncate to a whole number ========================================= _Description_: ! `AINT(X [, KIND])' truncates its argument to a whole number. _Standard_: ! F77 and later _Class_: Elemental function _Syntax_: ! `RESULT = AINT(X [, KIND])' _Arguments_: ! X 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 the magnitude of X is ! less than one, then `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. _Example_: program test_aint --- 3168,3208 ---- Name Argument Return type Standard `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 ! 7.11 `AINT' -- Truncate to a whole number ========================================= _Description_: ! `AINT(A [, KIND])' truncates its argument to a whole number. _Standard_: ! Fortran 77 and later _Class_: Elemental function _Syntax_: ! `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. _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 the magnitude of X is ! 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. _Example_: program test_aint *************** _Example_: *** 2814,2825 **** _Specific names_: Name Argument Return type Standard ! `DINT(X)' `REAL(8) X' `REAL(8)' F77 and later  File: gfortran.info, Node: ALARM, Next: ALL, Prev: AINT, Up: Intrinsic Procedures ! 6.12 `ALARM' -- Execute a routine after a given delay ===================================================== _Description_: --- 3216,3228 ---- _Specific names_: Name Argument Return type Standard ! `DINT(X)' `REAL(8) X' `REAL(8)' Fortran 77 and ! later  File: gfortran.info, Node: ALARM, Next: ALL, Prev: AINT, Up: Intrinsic Procedures ! 7.12 `ALARM' -- Execute a routine after a given delay ===================================================== _Description_: *************** _Example_: *** 2866,2872 ****  File: gfortran.info, Node: ALL, Next: ALLOCATED, Prev: ALARM, Up: Intrinsic Procedures ! 6.13 `ALL' -- All values in MASK along DIM are true =================================================== _Description_: --- 3269,3275 ----  File: gfortran.info, Node: ALL, Next: ALLOCATED, Prev: ALARM, Up: Intrinsic Procedures ! 7.13 `ALL' -- All values in MASK along DIM are true =================================================== _Description_: *************** _Description_: *** 2874,2880 **** in the array along dimension DIM. _Standard_: ! F95 and later _Class_: Transformational function --- 3277,3283 ---- in the array along dimension DIM. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _Syntax_: *** 2883,2896 **** `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. _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 --- 3286,3299 ---- `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. _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 *************** _Example_: *** 2926,2965 ****  File: gfortran.info, Node: ALLOCATED, Next: AND, Prev: ALL, Up: Intrinsic Procedures ! 6.14 `ALLOCATED' -- Status of an allocatable entity =================================================== _Description_: ! `ALLOCATED(X)' checks the status of whether X is allocated. _Standard_: ! F95 and later _Class_: Inquiry function _Syntax_: ! `RESULT = ALLOCATED(X)' _Arguments_: ! X The argument shall be an `ALLOCATABLE' array. _Return value_: The return value is a scalar `LOGICAL' with the default logical ! kind type parameter. If X is allocated, `ALLOCATED(X)' is `.TRUE.'; otherwise, it returns `.FALSE.' _Example_: program test_allocated integer :: i = 4 real(4), allocatable :: x(:) ! if (allocated(x) .eqv. .false.) allocate(x(i)) end program test_allocated  File: gfortran.info, Node: AND, Next: ANINT, Prev: ALLOCATED, Up: Intrinsic Procedures ! 6.15 `AND' -- Bitwise logical AND ================================= _Description_: --- 3329,3368 ----  File: gfortran.info, Node: ALLOCATED, Next: AND, Prev: ALL, Up: Intrinsic Procedures ! 7.14 `ALLOCATED' -- Status of an allocatable entity =================================================== _Description_: ! `ALLOCATED(ARRAY)' checks the status of whether X is allocated. _Standard_: ! Fortran 95 and later _Class_: Inquiry function _Syntax_: ! `RESULT = ALLOCATED(ARRAY)' _Arguments_: ! ARRAY The argument shall be an `ALLOCATABLE' array. _Return value_: The return value is a scalar `LOGICAL' with the default logical ! kind type parameter. If ARRAY is allocated, `ALLOCATED(ARRAY)' is `.TRUE.'; otherwise, it returns `.FALSE.' _Example_: program test_allocated integer :: i = 4 real(4), allocatable :: x(:) ! if (.not. allocated(x)) allocate(x(i)) end program test_allocated  File: gfortran.info, Node: AND, Next: ANINT, Prev: ALLOCATED, Up: Intrinsic Procedures ! 7.15 `AND' -- Bitwise logical AND ================================= _Description_: *************** _Syntax_: *** 2980,2993 **** `RESULT = AND(I, J)' _Arguments_: ! I The type shall be either `INTEGER(*)' or ! `LOGICAL'. ! J The type shall be either `INTEGER(*)' or ! `LOGICAL'. _Return value_: ! The return type is either `INTEGER(*)' or `LOGICAL' after ! cross-promotion of the arguments. _Example_: PROGRAM test_and --- 3383,3397 ---- `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. _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. _Example_: PROGRAM test_and *************** _Example_: *** 3000,3038 **** END PROGRAM _See also_: ! F95 elemental function: *note IAND::  File: gfortran.info, Node: ANINT, Next: ANY, Prev: AND, Up: Intrinsic Procedures ! 6.16 `ANINT' -- Nearest whole number ==================================== _Description_: ! `ANINT(X [, KIND])' rounds its argument to the nearest whole number. _Standard_: ! F77 and later _Class_: Elemental function _Syntax_: ! `RESULT = ANINT(X [, KIND])' _Arguments_: ! X 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 X is greater than zero, ! then `ANINT(X)' returns `AINT(X+0.5)'. If X is less than or equal ! to zero, then it returns `AINT(X-0.5)'. _Example_: program test_anint --- 3404,3442 ---- END PROGRAM _See also_: ! Fortran 95 elemental function: *note IAND::  File: gfortran.info, Node: ANINT, Next: ANY, Prev: AND, Up: Intrinsic Procedures ! 7.16 `ANINT' -- Nearest whole number ==================================== _Description_: ! `ANINT(A [, KIND])' rounds its argument to the nearest whole number. _Standard_: ! Fortran 77 and later _Class_: Elemental function _Syntax_: ! `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. _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)'. _Example_: program test_anint *************** _Example_: *** 3046,3057 **** _Specific names_: Name Argument Return type Standard ! `DNINT(X)' `REAL(8) X' `REAL(8)' F77 and later  File: gfortran.info, Node: ANY, Next: ASIN, Prev: ANINT, Up: Intrinsic Procedures ! 6.17 `ANY' -- Any value in MASK along DIM is true ================================================= _Description_: --- 3450,3462 ---- _Specific names_: Name Argument Return type Standard ! `DNINT(A)' `REAL(8) A' `REAL(8)' Fortran 77 and ! later  File: gfortran.info, Node: ANY, Next: ASIN, Prev: ANINT, Up: Intrinsic Procedures ! 7.17 `ANY' -- Any value in MASK along DIM is true ================================================= _Description_: *************** _Description_: *** 3059,3065 **** array MASK along dimension DIM are `.TRUE.'. _Standard_: ! F95 and later _Class_: Transformational function --- 3464,3470 ---- array MASK along dimension DIM are `.TRUE.'. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _Syntax_: *** 3068,3081 **** `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. _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 --- 3473,3486 ---- `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. _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 *************** _Example_: *** 3112,3125 ****  File: gfortran.info, Node: ASIN, Next: ASINH, Prev: ANY, Up: Intrinsic Procedures ! 6.18 `ASIN' -- Arcsine function =============================== _Description_: `ASIN(X)' computes the arcsine of its X (inverse of `SIN(X)'). _Standard_: ! F77 and later _Class_: Elemental function --- 3517,3530 ----  File: gfortran.info, Node: ASIN, Next: ASINH, Prev: ANY, Up: Intrinsic Procedures ! 7.18 `ASIN' -- Arcsine function =============================== _Description_: `ASIN(X)' computes the arcsine of its X (inverse of `SIN(X)'). _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Syntax_: *** 3128,3140 **** `RESULT = ASIN(X)' _Arguments_: ! X The type shall be `REAL(*)', and a magnitude ! that is less than one. _Return value_: ! The return value is of type `REAL(*)' and it lies in the range ! -\pi / 2 \leq \asin (x) \leq \pi / 2. The kind type parameter is ! the same as X. _Example_: program test_asin --- 3533,3545 ---- `RESULT = ASIN(X)' _Arguments_: ! X The type shall be `REAL', and a magnitude that ! is less than or equal to one. _Return value_: ! The return value is of type `REAL' and it lies in the range -\pi / ! 2 \leq \asin (x) \leq \pi / 2. The kind type parameter is the ! same as X. _Example_: program test_asin *************** _Example_: *** 3144,3150 **** _Specific names_: Name Argument Return type Standard ! `DASIN(X)' `REAL(8) X' `REAL(8)' F77 and later _See also_: Inverse function: *note SIN:: --- 3549,3556 ---- _Specific names_: Name Argument Return type Standard ! `DASIN(X)' `REAL(8) X' `REAL(8)' Fortran 77 and ! later _See also_: Inverse function: *note SIN:: *************** _See also_: *** 3153,3159 ****  File: gfortran.info, Node: ASINH, Next: ASSOCIATED, Prev: ASIN, Up: Intrinsic Procedures ! 6.19 `ASINH' -- Hyperbolic arcsine function =========================================== _Description_: --- 3559,3565 ----  File: gfortran.info, Node: ASINH, Next: ASSOCIATED, Prev: ASIN, Up: Intrinsic Procedures ! 7.19 `ASINH' -- Hyperbolic arcsine function =========================================== _Description_: *************** _Description_: *** 3161,3167 **** `SINH(X)'). _Standard_: ! GNU extension _Class_: Elemental function --- 3567,3573 ---- `SINH(X)'). _Standard_: ! Fortran 2008 and later _Class_: Elemental function *************** _Syntax_: *** 3170,3181 **** `RESULT = ASINH(X)' _Arguments_: ! X The type shall be `REAL(*)', with X a real ! number. _Return value_: ! The return value is of type `REAL(*)' and it lies in the range ! -\infty \leq \asinh (x) \leq \infty. _Example_: PROGRAM test_asinh --- 3576,3585 ---- `RESULT = ASINH(X)' _Arguments_: ! X The type shall be `REAL' or `COMPLEX'. _Return value_: ! The return value is of the same type and kind as X. _Example_: PROGRAM test_asinh *************** _See also_: *** 3193,3253 ****  File: gfortran.info, Node: ASSOCIATED, Next: ATAN, Prev: ASINH, Up: Intrinsic Procedures ! 6.20 `ASSOCIATED' -- Status of a pointer or pointer/target pair =============================================================== _Description_: ! `ASSOCIATED(PTR [, TGT])' determines the status of the pointer PTR ! or if PTR is associated with the target TGT. _Standard_: ! F95 and later _Class_: Inquiry function _Syntax_: ! `RESULT = ASSOCIATED(PTR [, TGT])' _Arguments_: ! PTR PTR shall have the `POINTER' attribute and it ! can be of any type. ! TGT (Optional) TGT shall be a `POINTER' or a ! `TARGET'. It must have the same type, kind ! type parameter, and array rank as PTR. ! The status of neither PTR nor TGT can be undefined. _Return value_: ! `ASSOCIATED(PTR)' returns a scalar value of type `LOGICAL(4)'. There are several cases: ! (A) If the optional TGT is not present, then `ASSOCIATED(PTR)' ! is true if PTR is associated with a target; otherwise, it ! returns false. ! (B) If TGT is present and a scalar target, the result is true if ! TGT is not a 0 sized storage sequence and the target ! associated with PTR occupies the same storage units. If PTR ! is disassociated, then the result is false. ! (C) If TGT is present and an array target, the result is true if ! TGT and PTR have the same shape, are not 0 sized arrays, are ! arrays whose elements are not 0 sized storage sequences, and ! TGT and PTR occupy the same storage units in array element ! order. As in case(B), the result is false, if PTR is ! disassociated. ! (D) If TGT is present and an scalar pointer, the result is true if ! target associated with PTR and the target associated with TGT ! are not 0 sized storage sequences and occupy the same storage ! units. The result is false, if either TGT or PTR is ! disassociated. ! (E) If TGT is present and an array pointer, the result is true if ! target associated with PTR and the target associated with TGT ! have the same shape, are not 0 sized arrays, are arrays whose ! elements are not 0 sized storage sequences, and TGT and PTR ! occupy the same storage units in array element order. The ! result is false, if either TGT or PTR is disassociated. _Example_: program test_associated --- 3597,3659 ----  File: gfortran.info, Node: ASSOCIATED, Next: ATAN, Prev: ASINH, Up: Intrinsic Procedures ! 7.20 `ASSOCIATED' -- Status of a pointer or pointer/target pair =============================================================== _Description_: ! `ASSOCIATED(POINTER [, TARGET])' determines the status of the ! pointer POINTER or if POINTER is associated with the target TARGET. _Standard_: ! Fortran 95 and later _Class_: Inquiry function _Syntax_: ! `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. ! The association status of neither POINTER nor TARGET shall be ! undefined. _Return value_: ! `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 ! target; otherwise, it returns false. ! (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 ! 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 ! 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 ! 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, ! and TARGET and POINTER occupy the same storage units in array ! element order. The result is false, if either TARGET or ! POINTER is disassociated. _Example_: program test_associated *************** _See also_: *** 3265,3278 ****  File: gfortran.info, Node: ATAN, Next: ATAN2, Prev: ASSOCIATED, Up: Intrinsic Procedures ! 6.21 `ATAN' -- Arctangent function ================================== _Description_: `ATAN(X)' computes the arctangent of X. _Standard_: ! F77 and later _Class_: Elemental function --- 3671,3684 ----  File: gfortran.info, Node: ATAN, Next: ATAN2, Prev: ASSOCIATED, Up: Intrinsic Procedures ! 7.21 `ATAN' -- Arctangent function ================================== _Description_: `ATAN(X)' computes the arctangent of X. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Syntax_: *** 3281,3291 **** `RESULT = ATAN(X)' _Arguments_: ! X The type shall be `REAL(*)'. _Return value_: ! The return value is of type `REAL(*)' and it lies in the range - ! \pi / 2 \leq \atan (x) \leq \pi / 2. _Example_: program test_atan --- 3687,3697 ---- `RESULT = ATAN(X)' _Arguments_: ! X The type shall be `REAL'. _Return value_: ! The return value is of type `REAL' and it lies in the range - \pi ! / 2 \leq \atan (x) \leq \pi / 2. _Example_: program test_atan *************** _Example_: *** 3295,3301 **** _Specific names_: Name Argument Return type Standard ! `DATAN(X)' `REAL(8) X' `REAL(8)' F77 and later _See also_: Inverse function: *note TAN:: --- 3701,3708 ---- _Specific names_: Name Argument Return type Standard ! `DATAN(X)' `REAL(8) X' `REAL(8)' Fortran 77 and ! later _See also_: Inverse function: *note TAN:: *************** _See also_: *** 3304,3326 ****  File: gfortran.info, Node: ATAN2, Next: ATANH, Prev: ATAN, Up: Intrinsic Procedures ! 6.22 `ATAN2' -- Arctangent function =================================== _Description_: ! `ATAN2(Y,X)' computes the arctangent of the complex number X + i Y. _Standard_: ! F77 and later _Class_: Elemental function _Syntax_: ! `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. --- 3711,3734 ----  File: gfortran.info, Node: ATAN2, Next: ATANH, Prev: ATAN, Up: Intrinsic Procedures ! 7.22 `ATAN2' -- Arctangent function =================================== _Description_: ! `ATAN2(Y, X)' computes the arctangent of the complex number X + i ! Y. _Standard_: ! Fortran 77 and later _Class_: Elemental function _Syntax_: ! `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. *************** _Example_: *** 3341,3352 **** _Specific names_: Name Argument Return type Standard ! `DATAN2(X)' `REAL(8) X' `REAL(8)' F77 and later  ! File: gfortran.info, Node: ATANH, Next: BESJ0, Prev: ATAN2, Up: Intrinsic Procedures ! 6.23 `ATANH' -- Hyperbolic arctangent function ============================================== _Description_: --- 3749,3761 ---- _Specific names_: Name Argument Return type Standard ! `DATAN2(X)' `REAL(8) X' `REAL(8)' Fortran 77 and ! later  ! File: gfortran.info, Node: ATANH, Next: BESSEL_J0, Prev: ATAN2, Up: Intrinsic Procedures ! 7.23 `ATANH' -- Hyperbolic arctangent function ============================================== _Description_: *************** _Description_: *** 3354,3360 **** `TANH(X)'). _Standard_: ! GNU extension _Class_: Elemental function --- 3763,3769 ---- `TANH(X)'). _Standard_: ! Fortran 2008 and later _Class_: Elemental function *************** _Syntax_: *** 3363,3374 **** `RESULT = ATANH(X)' _Arguments_: ! X The type shall be `REAL(*)' with a magnitude ! that is less than or equal to one. _Return value_: ! The return value is of type `REAL(*)' and it lies in the range ! -\infty \leq \atanh(x) \leq \infty. _Example_: PROGRAM test_atanh --- 3772,3781 ---- `RESULT = ATANH(X)' _Arguments_: ! X The type shall be `REAL' or `COMPLEX'. _Return value_: ! The return value has same type and kind as X. _Example_: PROGRAM test_atanh *************** _See also_: *** 3384,3419 **** Inverse function: *note TANH::  ! File: gfortran.info, Node: BESJ0, Next: BESJ1, Prev: ATANH, Up: Intrinsic Procedures ! 6.24 `BESJ0' -- Bessel function of the first kind of order 0 ! ============================================================ _Description_: ! `BESJ0(X)' computes the Bessel function of the first kind of order ! 0 of X. _Standard_: ! GNU extension _Class_: Elemental function _Syntax_: ! `RESULT = BESJ0(X)' _Arguments_: ! X The type shall be `REAL(*)', and it shall be scalar. _Return value_: ! The return value is of type `REAL(*)' and it lies in the range - ! 0.4027... \leq Bessel (0,x) \leq 1. _Example_: program test_besj0 real(8) :: x = 0.0_8 ! x = besj0(x) end program test_besj0 _Specific names_: --- 3791,3827 ---- Inverse function: *note TANH::  ! File: gfortran.info, Node: BESSEL_J0, Next: BESSEL_J1, Prev: ATANH, Up: Intrinsic Procedures ! 7.24 `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 ! a GNU extension. _Standard_: ! Fortran 2008 and later _Class_: Elemental function _Syntax_: ! `RESULT = BESSEL_J0(X)' _Arguments_: ! X The type shall be `REAL', and it shall be scalar. _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. _Example_: program test_besj0 real(8) :: x = 0.0_8 ! x = bessel_j0(x) end program test_besj0 _Specific names_: *************** _Specific names_: *** 3421,3456 **** `DBESJ0(X)' `REAL(8) X' `REAL(8)' GNU extension  ! File: gfortran.info, Node: BESJ1, Next: BESJN, Prev: BESJ0, Up: Intrinsic Procedures ! 6.25 `BESJ1' -- Bessel function of the first kind of order 1 ! ============================================================ _Description_: ! `BESJ1(X)' computes the Bessel function of the first kind of order ! 1 of X. _Standard_: ! GNU extension _Class_: Elemental function _Syntax_: ! `RESULT = BESJ1(X)' _Arguments_: ! X The type shall be `REAL(*)', and it shall be scalar. _Return value_: ! The return value is of type `REAL(*)' and it lies in the range - ! 0.5818... \leq Bessel (0,x) \leq 0.5818 . _Example_: program test_besj1 real(8) :: x = 1.0_8 ! x = besj1(x) end program test_besj1 _Specific names_: --- 3829,3866 ---- `DBESJ0(X)' `REAL(8) X' `REAL(8)' GNU extension  ! File: gfortran.info, Node: BESSEL_J1, Next: BESSEL_JN, Prev: BESSEL_J0, Up: Intrinsic Procedures ! 7.25 `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 ! a GNU extension. _Standard_: ! Fortran 2008 _Class_: Elemental function _Syntax_: ! `RESULT = BESSEL_J1(X)' _Arguments_: ! X The type shall be `REAL', and it shall be scalar. _Return value_: ! The return value is of type `REAL' and it lies in the range - ! 0.5818... \leq Bessel (0,x) \leq 0.5818 . It has the same kind as ! X. _Example_: program test_besj1 real(8) :: x = 1.0_8 ! x = bessel_j1(x) end program test_besj1 _Specific names_: *************** _Specific names_: *** 3458,3534 **** `DBESJ1(X)' `REAL(8) X' `REAL(8)' GNU extension  ! File: gfortran.info, Node: BESJN, Next: BESY0, Prev: BESJ1, Up: Intrinsic Procedures ! 6.26 `BESJN' -- Bessel function of the first kind ! ================================================= _Description_: ! `BESJN(N, X)' computes the Bessel function of the first kind of ! order N of X. If both arguments are arrays, their ranks and shapes shall conform. _Standard_: ! GNU extension _Class_: Elemental function _Syntax_: ! `RESULT = BESJN(N, X)' _Arguments_: N Shall be a scalar or an array of type ! `INTEGER(*)'. ! X Shall be a scalar or an array of type ! `REAL(*)'. _Return value_: ! The return value is a scalar of type `REAL(*)'. _Example_: program test_besjn real(8) :: x = 1.0_8 ! x = besjn(5,x) end program test_besjn _Specific names_: Name Argument Return type Standard ! `DBESJN(X)' `INTEGER(*) `REAL(8)' GNU extension ! N' `REAL(8) X'  ! File: gfortran.info, Node: BESY0, Next: BESY1, Prev: BESJN, Up: Intrinsic Procedures ! 6.27 `BESY0' -- Bessel function of the second kind of order 0 ! ============================================================= _Description_: ! `BESY0(X)' computes the Bessel function of the second kind of ! order 0 of X. _Standard_: ! GNU extension _Class_: Elemental function _Syntax_: ! `RESULT = BESY0(X)' _Arguments_: ! X The type shall be `REAL(*)', and it shall be scalar. _Return value_: ! The return value is a scalar of type `REAL(*)'. _Example_: program test_besy0 real(8) :: x = 0.0_8 ! x = besy0(x) end program test_besy0 _Specific names_: --- 3868,3946 ---- `DBESJ1(X)' `REAL(8) X' `REAL(8)' GNU extension  ! File: gfortran.info, Node: BESSEL_JN, Next: BESSEL_Y0, Prev: BESSEL_J1, Up: Intrinsic Procedures ! 7.26 `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 ! a GNU extension. If both arguments are arrays, their ranks and shapes shall conform. _Standard_: ! Fortran 2008 and later _Class_: Elemental function _Syntax_: ! `RESULT = BESSEL_JN(N, X)' _Arguments_: N Shall be a scalar or an array of type ! `INTEGER'. ! X Shall be a scalar or an array of type `REAL'. _Return value_: ! The return value is a scalar of type `REAL'. It has the same kind ! as X. _Example_: program test_besjn real(8) :: x = 1.0_8 ! x = bessel_jn(5,x) end program test_besjn _Specific names_: Name Argument Return type Standard ! `DBESJN(X)' `INTEGER N' `REAL(8)' GNU extension `REAL(8) X'  ! File: gfortran.info, Node: BESSEL_Y0, Next: BESSEL_Y1, Prev: BESSEL_JN, Up: Intrinsic Procedures ! 7.27 `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 ! a GNU extension. _Standard_: ! Fortran 2008 and later _Class_: Elemental function _Syntax_: ! `RESULT = BESSEL_Y0(X)' _Arguments_: ! X The type shall be `REAL', and it shall be scalar. _Return value_: ! The return value is a scalar of type `REAL'. It has the same kind ! as X. _Example_: program test_besy0 real(8) :: x = 0.0_8 ! x = bessel_y0(x) end program test_besy0 _Specific names_: *************** _Specific names_: *** 3536,3570 **** `DBESY0(X)' `REAL(8) X' `REAL(8)' GNU extension  ! File: gfortran.info, Node: BESY1, Next: BESYN, Prev: BESY0, Up: Intrinsic Procedures ! 6.28 `BESY1' -- Bessel function of the second kind of order 1 ! ============================================================= _Description_: ! `BESY1(X)' computes the Bessel function of the second kind of ! order 1 of X. _Standard_: ! GNU extension _Class_: Elemental function _Syntax_: ! `RESULT = BESY1(X)' _Arguments_: ! X The type shall be `REAL(*)', and it shall be scalar. _Return value_: ! The return value is a scalar of type `REAL(*)'. _Example_: program test_besy1 real(8) :: x = 1.0_8 ! x = besy1(x) end program test_besy1 _Specific names_: --- 3948,3984 ---- `DBESY0(X)' `REAL(8) X' `REAL(8)' GNU extension  ! File: gfortran.info, Node: BESSEL_Y1, Next: BESSEL_YN, Prev: BESSEL_Y0, Up: Intrinsic Procedures ! 7.28 `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 ! a GNU extension. _Standard_: ! Fortran 2008 and later _Class_: Elemental function _Syntax_: ! `RESULT = BESSEL_Y1(X)' _Arguments_: ! X The type shall be `REAL', and it shall be scalar. _Return value_: ! The return value is a scalar of type `REAL'. It has the same kind ! as X. _Example_: program test_besy1 real(8) :: x = 1.0_8 ! x = bessel_y1(x) end program test_besy1 _Specific names_: *************** _Specific names_: *** 3572,3631 **** `DBESY1(X)' `REAL(8) X' `REAL(8)' GNU extension  ! File: gfortran.info, Node: BESYN, Next: BIT_SIZE, Prev: BESY1, Up: Intrinsic Procedures ! 6.29 `BESYN' -- Bessel function of the second kind ! ================================================== _Description_: ! `BESYN(N, X)' computes the Bessel function of the second kind of ! order N of X. If both arguments are arrays, their ranks and shapes shall conform. _Standard_: ! GNU extension _Class_: Elemental function _Syntax_: ! `RESULT = BESYN(N, X)' _Arguments_: N Shall be a scalar or an array of type ! `INTEGER(*)'. ! X Shall be a scalar or an array of type ! `REAL(*)'. _Return value_: ! The return value is a scalar of type `REAL(*)'. _Example_: program test_besyn real(8) :: x = 1.0_8 ! x = besyn(5,x) end program test_besyn _Specific names_: Name Argument Return type Standard ! `DBESYN(N,X)' `INTEGER(*) `REAL(8)' GNU extension ! N' `REAL(8) X'  ! File: gfortran.info, Node: BIT_SIZE, Next: BTEST, Prev: BESYN, Up: Intrinsic Procedures ! 6.30 `BIT_SIZE' -- Bit size inquiry function ============================================ _Description_: `BIT_SIZE(I)' returns the number of bits (integer precision plus ! sign bit) represented by the type of I. _Standard_: ! F95 and later _Class_: Inquiry function --- 3986,4046 ---- `DBESY1(X)' `REAL(8) X' `REAL(8)' GNU extension  ! File: gfortran.info, Node: BESSEL_YN, Next: BIT_SIZE, Prev: BESSEL_Y1, Up: Intrinsic Procedures ! 7.29 `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' ! as a GNU extension. If both arguments are arrays, their ranks and shapes shall conform. _Standard_: ! Fortran 2008 and later _Class_: Elemental function _Syntax_: ! `RESULT = BESSEL_YN(N, X)' _Arguments_: N Shall be a scalar or an array of type ! `INTEGER'. ! X Shall be a scalar or an array of type `REAL'. _Return value_: ! The return value is a scalar of type `REAL'. It has the same kind ! as X. _Example_: program test_besyn real(8) :: x = 1.0_8 ! x = bessel_yn(5,x) end program test_besyn _Specific names_: Name Argument Return type Standard ! `DBESYN(N,X)' `INTEGER N' `REAL(8)' GNU extension `REAL(8) X'  ! File: gfortran.info, Node: BIT_SIZE, Next: BTEST, Prev: BESSEL_YN, Up: Intrinsic Procedures ! 7.30 `BIT_SIZE' -- Bit size inquiry function ============================================ _Description_: `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. _Standard_: ! Fortran 95 and later _Class_: Inquiry function *************** _Syntax_: *** 3634,3643 **** `RESULT = BIT_SIZE(I)' _Arguments_: ! I The type shall be `INTEGER(*)'. _Return value_: ! The return value is of type `INTEGER(*)' _Example_: program test_bit_size --- 4049,4058 ---- `RESULT = BIT_SIZE(I)' _Arguments_: ! I The type shall be `INTEGER'. _Return value_: ! The return value is of type `INTEGER' _Example_: program test_bit_size *************** _Example_: *** 3650,3664 ****  File: gfortran.info, Node: BTEST, Next: C_ASSOCIATED, Prev: BIT_SIZE, Up: Intrinsic Procedures ! 6.31 `BTEST' -- Bit test function ================================= _Description_: `BTEST(I,POS)' returns logical `.TRUE.' if the bit at POS in I is ! set. _Standard_: ! F95 and later _Class_: Elemental function --- 4065,4079 ----  File: gfortran.info, Node: BTEST, Next: C_ASSOCIATED, Prev: BIT_SIZE, Up: Intrinsic Procedures ! 7.31 `BTEST' -- Bit test function ================================= _Description_: `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 _Class_: Elemental function *************** _Syntax_: *** 3667,3674 **** `RESULT = BTEST(I, POS)' _Arguments_: ! I The type shall be `INTEGER(*)'. ! POS The type shall be `INTEGER(*)'. _Return value_: The return value is of type `LOGICAL' --- 4082,4089 ---- `RESULT = BTEST(I, POS)' _Arguments_: ! I The type shall be `INTEGER'. ! POS The type shall be `INTEGER'. _Return value_: The return value is of type `LOGICAL' *************** _Example_: *** 3687,3715 ****  File: gfortran.info, Node: C_ASSOCIATED, Next: C_F_POINTER, Prev: BTEST, Up: Intrinsic Procedures ! 6.32 `C_ASSOCIATED' -- Status of a C pointer ============================================ _Description_: ! `C_ASSOICATED(c_prt1[, c_ptr2])' determines the status of the C ! pointer C_PTR1 or if C_PTR1 is associated with the target C_PTR2. _Standard_: ! F2003 and later _Class_: Inquiry function _Syntax_: ! `RESULT = C_ASSOICATED(c_prt1[, c_ptr2])' _Arguments_: ! C_PTR1 Scalar of the type `C_PTR' or `C_FUNPTR'. ! C_PTR2 (Optional) Scalar of the same type as C_PTR1. _Return value_: The return value is of type `LOGICAL'; it is `.false.' if either ! C_PTR1 is a C NULL pointer or if C_PTR1 and C_PTR2 point to different addresses. _Example_: --- 4102,4131 ----  File: gfortran.info, Node: C_ASSOCIATED, Next: C_F_POINTER, Prev: BTEST, Up: Intrinsic Procedures ! 7.32 `C_ASSOCIATED' -- Status of a C pointer ============================================ _Description_: ! `C_ASSOCIATED(c_prt_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. _Standard_: ! Fortran 2003 and later _Class_: Inquiry function _Syntax_: ! `RESULT = C_ASSOCIATED(c_prt_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. _Return value_: 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. _Example_: *************** _See also_: *** 3728,3741 ****  File: gfortran.info, Node: C_FUNLOC, Next: C_LOC, Prev: C_F_PROCPOINTER, Up: Intrinsic Procedures ! 6.33 `C_FUNLOC' -- Obtain the C address of a procedure ====================================================== _Description_: `C_FUNLOC(x)' determines the C address of the argument. _Standard_: ! F2003 and later _Class_: Inquiry function --- 4144,4157 ----  File: gfortran.info, Node: C_FUNLOC, Next: C_LOC, Prev: C_F_PROCPOINTER, Up: Intrinsic Procedures ! 7.33 `C_FUNLOC' -- Obtain the C address of a procedure ====================================================== _Description_: `C_FUNLOC(x)' determines the C address of the argument. _Standard_: ! Fortran 2003 and later _Class_: Inquiry function *************** _See also_: *** 3781,3798 ****  File: gfortran.info, Node: C_F_PROCPOINTER, Next: C_FUNLOC, Prev: C_F_POINTER, Up: Intrinsic Procedures ! 6.34 `C_F_PROCPOINTER' -- Convert C into Fortran procedure pointer ================================================================== _Description_: ! `C_F_PROCPOINTER(cptr, fptr)' Assign the target of the C function pointer CPTR to the Fortran procedure pointer FPTR. Note: Due to the currently lacking support of procedure pointers in GNU Fortran this function is not fully operable. _Standard_: ! F2003 and later _Class_: Subroutine --- 4197,4214 ----  File: gfortran.info, Node: C_F_PROCPOINTER, Next: C_FUNLOC, Prev: C_F_POINTER, Up: Intrinsic Procedures ! 7.34 `C_F_PROCPOINTER' -- Convert C into Fortran procedure pointer ================================================================== _Description_: ! `C_F_PROCPOINTER(CPTR, FPTR)' Assign the target of the C function pointer CPTR to the Fortran procedure pointer FPTR. Note: Due to the currently lacking support of procedure pointers in GNU Fortran this function is not fully operable. _Standard_: ! Fortran 2003 and later _Class_: Subroutine *************** _Syntax_: *** 3802,3810 **** _Arguments_: CPTR scalar of the type `C_FUNPTR'. It is ! `INTENT(IN)'. FPTR procedure pointer interoperable with CPTR. It ! is `INTENT(OUT)'. _Example_: program main --- 4218,4226 ---- _Arguments_: CPTR scalar of the type `C_FUNPTR'. It is ! `INTENT(IN)'. FPTR procedure pointer interoperable with CPTR. It ! is `INTENT(OUT)'. _Example_: program main *************** _See also_: *** 3835,3866 ****  File: gfortran.info, Node: C_F_POINTER, Next: C_F_PROCPOINTER, Prev: C_ASSOCIATED, Up: Intrinsic Procedures ! 6.35 `C_F_POINTER' -- Convert C into Fortran pointer ==================================================== _Description_: ! `C_F_POINTER(cptr, fptr[, shape])' Assign the target the C pointer CPTR to the Fortran pointer FPTR and specify its shape. _Standard_: ! F2003 and later _Class_: Subroutine _Syntax_: ! `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. _Example_: program main --- 4251,4280 ----  File: gfortran.info, Node: C_F_POINTER, Next: C_F_PROCPOINTER, Prev: C_ASSOCIATED, Up: Intrinsic Procedures ! 7.35 `C_F_POINTER' -- Convert C into Fortran pointer ==================================================== _Description_: ! `C_F_POINTER(CPTR, FPTR[, SHAPE])' Assign the target the C pointer CPTR to the Fortran pointer FPTR and specify its shape. _Standard_: ! Fortran 2003 and later _Class_: Subroutine _Syntax_: ! `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. _Example_: program main *************** _See also_: *** 3882,3908 **** *note C_LOC::, *note C_F_PROCPOINTER::  ! File: gfortran.info, Node: C_LOC, Next: CEILING, Prev: C_FUNLOC, Up: Intrinsic Procedures ! 6.36 `C_LOC' -- Obtain the C address of an object ================================================= _Description_: ! `C_LOC(x)' determines the C address of the argument. _Standard_: ! F2003 and later _Class_: Inquiry function _Syntax_: ! `RESULT = C_LOC(x)' _Arguments_: X Associated scalar pointer or interoperable ! scalar or allocated allocatable ! variable with `TARGET' attribute. _Return value_: The return value is of type `C_PTR' and contains the C address of --- 4296,4322 ---- *note C_LOC::, *note C_F_PROCPOINTER::  ! File: gfortran.info, Node: C_LOC, Next: C_SIZEOF, Prev: C_FUNLOC, Up: Intrinsic Procedures ! 7.36 `C_LOC' -- Obtain the C address of an object ================================================= _Description_: ! `C_LOC(X)' determines the C address of the argument. _Standard_: ! Fortran 2003 and later _Class_: Inquiry function _Syntax_: ! `RESULT = C_LOC(X)' _Arguments_: X Associated scalar pointer or interoperable ! scalar or allocated allocatable variable with ! `TARGET' attribute. _Return value_: The return value is of type `C_PTR' and contains the C address of *************** _See also_: *** 3923,3953 **** C_F_PROCPOINTER::  ! File: gfortran.info, Node: CEILING, Next: CHAR, Prev: C_LOC, Up: Intrinsic Procedures ! 6.37 `CEILING' -- Integer ceiling function ========================================== _Description_: ! `CEILING(X)' returns the least integer greater than or equal to X. _Standard_: ! F95 and later _Class_: Elemental function _Syntax_: ! `RESULT = CEILING(X [, KIND])' _Arguments_: ! X 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)' _Example_: program test_ceiling --- 4337,4412 ---- C_F_PROCPOINTER::  ! File: gfortran.info, Node: C_SIZEOF, Next: CEILING, Prev: C_LOC, Up: Intrinsic Procedures ! 7.37 `C_SIZEOF' -- Size in bytes of an expression ! ================================================= ! ! _Description_: ! `C_SIZEOF(X)' calculates the number of bytes of storage the ! expression `X' occupies. ! ! _Standard_: ! Fortran 2008 ! ! _Class_: ! Intrinsic function ! ! _Syntax_: ! `N = C_SIZEOF(X)' ! ! _Arguments_: ! 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 ! 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 doesn't ! account for the sizes of the data pointed to by these components. ! ! _Example_: ! use iso_c_binding ! integer(c_int) :: i ! 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. ! ! _See also_: ! *note SIZEOF:: ! !  ! File: gfortran.info, Node: CEILING, Next: CHAR, Prev: C_SIZEOF, Up: Intrinsic Procedures ! ! 7.38 `CEILING' -- Integer ceiling function ========================================== _Description_: ! `CEILING(A)' returns the least integer greater than or equal to A. _Standard_: ! Fortran 95 and later _Class_: Elemental function _Syntax_: ! `RESULT = CEILING(A [, KIND])' _Arguments_: ! 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. _Example_: program test_ceiling *************** _See also_: *** 3964,3970 ****  File: gfortran.info, Node: CHAR, Next: CHDIR, Prev: CEILING, Up: Intrinsic Procedures ! 6.38 `CHAR' -- Character conversion function ============================================ _Description_: --- 4423,4429 ----  File: gfortran.info, Node: CHAR, Next: CHDIR, Prev: CEILING, Up: Intrinsic Procedures ! 7.39 `CHAR' -- Character conversion function ============================================ _Description_: *************** _Description_: *** 3972,3978 **** integer I. _Standard_: ! F77 and later _Class_: Elemental function --- 4431,4437 ---- integer I. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Syntax_: *** 3981,3990 **** `RESULT = CHAR(I [, KIND])' _Arguments_: ! 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)' --- 4440,4449 ---- `RESULT = CHAR(I [, KIND])' _Arguments_: ! 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)' *************** _See also_: *** 4008,4014 ****  File: gfortran.info, Node: CHDIR, Next: CHMOD, Prev: CHAR, Up: Intrinsic Procedures ! 6.39 `CHDIR' -- Change working directory ======================================== _Description_: --- 4467,4473 ----  File: gfortran.info, Node: CHDIR, Next: CHMOD, Prev: CHAR, Up: Intrinsic Procedures ! 7.40 `CHDIR' -- Change working directory ======================================== _Description_: *************** _Syntax_: *** 4028,4040 **** `STATUS = CHDIR(NAME)' _Arguments_: ! NAME The type shall be `CHARACTER(*)' 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 --- 4487,4498 ---- `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. _Example_: PROGRAM test_chdir *************** _See also_: *** 4052,4058 ****  File: gfortran.info, Node: CHMOD, Next: CMPLX, Prev: CHDIR, Up: Intrinsic Procedures ! 6.40 `CHMOD' -- Change access permissions of files ================================================== _Description_: --- 4510,4516 ----  File: gfortran.info, Node: CHMOD, Next: CMPLX, Prev: CHDIR, Up: Intrinsic Procedures ! 7.41 `CHMOD' -- Change access permissions of files ================================================== _Description_: *************** _Syntax_: *** 4073,4086 **** `STATUS = CHMOD(NAME, MODE)' _Arguments_: ! NAME Scalar `CHARACTER' 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' giving the file permission. ! MODE uses the same syntax as the MODE argument ! of `/bin/chmod'. STATUS (optional) scalar `INTEGER', which is `0' on success and nonzero otherwise. --- 4531,4544 ---- `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 MODE argument of `/bin/chmod'. STATUS (optional) scalar `INTEGER', which is `0' on success and nonzero otherwise. *************** _Example_: *** 4108,4114 ****  File: gfortran.info, Node: CMPLX, Next: COMMAND_ARGUMENT_COUNT, Prev: CHMOD, Up: Intrinsic Procedures ! 6.41 `CMPLX' -- Complex conversion function =========================================== _Description_: --- 4566,4572 ----  File: gfortran.info, Node: CMPLX, Next: COMMAND_ARGUMENT_COUNT, Prev: CHMOD, Up: Intrinsic Procedures ! 7.42 `CMPLX' -- Complex conversion function =========================================== _Description_: *************** _Description_: *** 4119,4125 **** not be present. _Standard_: ! F77 and later _Class_: Elemental function --- 4577,4583 ---- not be present. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Syntax_: *** 4128,4141 **** `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. _Return value_: The return value is of `COMPLEX' type, with a kind equal to KIND --- 4586,4598 ---- `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. _Return value_: The return value is of `COMPLEX' type, with a kind equal to KIND *************** _See also_: *** 4157,4163 ****  File: gfortran.info, Node: COMMAND_ARGUMENT_COUNT, Next: COMPLEX, Prev: CMPLX, Up: Intrinsic Procedures ! 6.42 `COMMAND_ARGUMENT_COUNT' -- Get number of command line arguments ===================================================================== _Description_: --- 4614,4620 ----  File: gfortran.info, Node: COMMAND_ARGUMENT_COUNT, Next: COMPLEX, Prev: CMPLX, Up: Intrinsic Procedures ! 7.43 `COMMAND_ARGUMENT_COUNT' -- Get number of command line arguments ===================================================================== _Description_: *************** _Description_: *** 4165,4171 **** on the command line when the containing program was invoked. _Standard_: ! F2003 _Class_: Inquiry function --- 4622,4628 ---- on the command line when the containing program was invoked. _Standard_: ! Fortran 2003 and later _Class_: Inquiry function *************** _See also_: *** 4192,4198 ****  File: gfortran.info, Node: COMPLEX, Next: CONJG, Prev: COMMAND_ARGUMENT_COUNT, Up: Intrinsic Procedures ! 6.43 `COMPLEX' -- Complex conversion function ============================================= _Description_: --- 4649,4655 ----  File: gfortran.info, Node: COMPLEX, Next: CONJG, Prev: COMMAND_ARGUMENT_COUNT, Up: Intrinsic Procedures ! 7.44 `COMPLEX' -- Complex conversion function ============================================= _Description_: *************** _Syntax_: *** 4209,4216 **** `RESULT = COMPLEX(X, Y)' _Arguments_: ! 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 --- 4666,4673 ---- `RESULT = COMPLEX(X, Y)' _Arguments_: ! 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 *************** _See also_: *** 4234,4240 ****  File: gfortran.info, Node: CONJG, Next: COS, Prev: COMPLEX, Up: Intrinsic Procedures ! 6.44 `CONJG' -- Complex conjugate function ========================================== _Description_: --- 4691,4697 ----  File: gfortran.info, Node: CONJG, Next: COS, Prev: COMPLEX, Up: Intrinsic Procedures ! 7.45 `CONJG' -- Complex conjugate function ========================================== _Description_: *************** _Description_: *** 4242,4248 **** result is `(x, -y)' _Standard_: ! F77 and later, has overloads that are GNU extensions _Class_: Elemental function --- 4699,4705 ---- result is `(x, -y)' _Standard_: ! Fortran 77 and later, has overloads that are GNU extensions _Class_: Elemental function *************** _Syntax_: *** 4251,4260 **** `Z = CONJG(Z)' _Arguments_: ! Z The type shall be `COMPLEX(*)'. _Return value_: ! The return value is of type `COMPLEX(*)'. _Example_: program test_conjg --- 4708,4717 ---- `Z = CONJG(Z)' _Arguments_: ! Z The type shall be `COMPLEX'. _Return value_: ! The return value is of type `COMPLEX'. _Example_: program test_conjg *************** _Specific names_: *** 4274,4287 ****  File: gfortran.info, Node: COS, Next: COSH, Prev: CONJG, Up: Intrinsic Procedures ! 6.45 `COS' -- Cosine function ============================= _Description_: `COS(X)' computes the cosine of X. _Standard_: ! F77 and later, has overloads that are GNU extensions _Class_: Elemental function --- 4731,4744 ----  File: gfortran.info, Node: COS, Next: COSH, Prev: CONJG, Up: Intrinsic Procedures ! 7.46 `COS' -- Cosine function ============================= _Description_: `COS(X)' computes the cosine of X. _Standard_: ! Fortran 77 and later, has overloads that are GNU extensions _Class_: Elemental function *************** _Syntax_: *** 4290,4299 **** `RESULT = COS(X)' _Arguments_: ! X The type shall be `REAL(*)' or `COMPLEX(*)'. _Return value_: ! The return value is of type `REAL(*)' and it lies in the range -1 \leq \cos (x) \leq 1. The kind type parameter is the same as X. _Example_: --- 4747,4756 ---- `RESULT = COS(X)' _Arguments_: ! X The type shall be `REAL' or `COMPLEX'. _Return value_: ! The return value is of type `REAL' and it lies in the range -1 \leq \cos (x) \leq 1. The kind type parameter is the same as X. _Example_: *************** _Example_: *** 4304,4312 **** _Specific names_: Name Argument Return type Standard ! `DCOS(X)' `REAL(8) X' `REAL(8)' F77 and later ! `CCOS(X)' `COMPLEX(4) `COMPLEX(4)' F77 and later ! X' `ZCOS(X)' `COMPLEX(8) `COMPLEX(8)' GNU extension X' `CDCOS(X)' `COMPLEX(8) `COMPLEX(8)' GNU extension --- 4761,4770 ---- _Specific names_: Name Argument Return type Standard ! `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 *************** _See also_: *** 4319,4332 ****  File: gfortran.info, Node: COSH, Next: COUNT, Prev: COS, Up: Intrinsic Procedures ! 6.46 `COSH' -- Hyperbolic cosine function ========================================= _Description_: `COSH(X)' computes the hyperbolic cosine of X. _Standard_: ! F77 and later _Class_: Elemental function --- 4777,4790 ----  File: gfortran.info, Node: COSH, Next: COUNT, Prev: COS, Up: Intrinsic Procedures ! 7.47 `COSH' -- Hyperbolic cosine function ========================================= _Description_: `COSH(X)' computes the hyperbolic cosine of X. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Syntax_: *** 4335,4345 **** `X = COSH(X)' _Arguments_: ! X The type shall be `REAL(*)'. _Return value_: ! The return value is of type `REAL(*)' and it is positive ( \cosh ! (x) \geq 0 . _Example_: program test_cosh --- 4793,4804 ---- `X = COSH(X)' _Arguments_: ! X The type shall be `REAL'. _Return value_: ! The return value is of type `REAL' and it is positive ( \cosh (x) ! \geq 0 ). For a `REAL' argument X, \cosh (x) \geq 1 . The ! return value is of the same kind as X. _Example_: program test_cosh *************** _Example_: *** 4349,4355 **** _Specific names_: Name Argument Return type Standard ! `DCOSH(X)' `REAL(8) X' `REAL(8)' F77 and later _See also_: Inverse function: *note ACOSH:: --- 4808,4815 ---- _Specific names_: Name Argument Return type Standard ! `DCOSH(X)' `REAL(8) X' `REAL(8)' Fortran 77 and ! later _See also_: Inverse function: *note ACOSH:: *************** _See also_: *** 4358,4374 ****  File: gfortran.info, Node: COUNT, Next: CPU_TIME, Prev: COSH, Up: Intrinsic Procedures ! 6.47 `COUNT' -- Count function ============================== _Description_: `COUNT(MASK [, DIM [, KIND]])' counts the number of `.TRUE.' elements of MASK along the dimension of DIM. If DIM is omitted it ! is taken to be `1'. DIM is a scaler of type `INTEGER' in the range of 1 /leq DIM /leq n) where n is the rank of MASK. _Standard_: ! F95 and later _Class_: Transformational function --- 4818,4834 ----  File: gfortran.info, Node: COUNT, Next: CPU_TIME, Prev: COSH, Up: Intrinsic Procedures ! 7.48 `COUNT' -- Count function ============================== _Description_: `COUNT(MASK [, DIM [, KIND]])' counts the number of `.TRUE.' elements of MASK 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 MASK. _Standard_: ! Fortran 95 and later, with KIND argument Fortran 2003 and later _Class_: Transformational function *************** _Arguments_: *** 4380,4387 **** 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 --- 4840,4847 ---- 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 *************** _Example_: *** 4414,4424 ****  File: gfortran.info, Node: CPU_TIME, Next: CSHIFT, Prev: COUNT, Up: Intrinsic Procedures ! 6.48 `CPU_TIME' -- CPU elapsed time in seconds ============================================== _Description_: ! Returns a `REAL(*)' value representing the elapsed CPU time in seconds. This is useful for testing segments of code to determine execution time. --- 4874,4884 ----  File: gfortran.info, Node: CPU_TIME, Next: CSHIFT, Prev: COUNT, Up: Intrinsic Procedures ! 7.49 `CPU_TIME' -- CPU elapsed time in seconds ============================================== _Description_: ! Returns a `REAL' value representing the elapsed CPU time in seconds. This is useful for testing segments of code to determine execution time. *************** _Description_: *** 4432,4438 **** subroutine, as shown in the example below, should be used. _Standard_: ! F95 and later _Class_: Subroutine --- 4892,4898 ---- subroutine, as shown in the example below, should be used. _Standard_: ! Fortran 95 and later _Class_: Subroutine *************** _Syntax_: *** 4441,4447 **** `CALL CPU_TIME(TIME)' _Arguments_: ! TIME The type shall be `REAL(*)' with `INTENT(OUT)'. _Return value_: None --- 4901,4907 ---- `CALL CPU_TIME(TIME)' _Arguments_: ! TIME The type shall be `REAL' with `INTENT(OUT)'. _Return value_: None *************** _See also_: *** 4461,4473 ****  File: gfortran.info, Node: CSHIFT, Next: CTIME, Prev: CPU_TIME, Up: Intrinsic Procedures ! 6.49 `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 scaler 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 --- 4921,4933 ----  File: gfortran.info, Node: CSHIFT, Next: CTIME, Prev: CPU_TIME, Up: Intrinsic Procedures ! 7.50 `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 *************** _Description_: *** 4476,4482 **** back in the other end. _Standard_: ! F95 and later _Class_: Transformational function --- 4936,4942 ---- back in the other end. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _Example_: *** 4509,4515 ****  File: gfortran.info, Node: CTIME, Next: DATE_AND_TIME, Prev: CSHIFT, Up: Intrinsic Procedures ! 6.50 `CTIME' -- Convert a time into a string ============================================ _Description_: --- 4969,4975 ----  File: gfortran.info, Node: CTIME, Next: DATE_AND_TIME, Prev: CSHIFT, Up: Intrinsic Procedures ! 7.51 `CTIME' -- Convert a time into a string ============================================ _Description_: *************** _Syntax_: *** 4531,4537 **** _Arguments_: TIME The type shall be of type `INTEGER(KIND=8)'. ! RESULT The type shall be of type `CHARACTER'. _Return value_: The converted date and time as a string. --- 4991,4998 ---- _Arguments_: TIME The type shall be of type `INTEGER(KIND=8)'. ! RESULT The type shall be of type `CHARACTER' and of ! default kind. _Return value_: The converted date and time as a string. *************** _See Also_: *** 4554,4560 ****  File: gfortran.info, Node: DATE_AND_TIME, Next: DBLE, Prev: CTIME, Up: Intrinsic Procedures ! 6.51 `DATE_AND_TIME' -- Date and time subroutine ================================================ _Description_: --- 5015,5021 ----  File: gfortran.info, Node: DATE_AND_TIME, Next: DBLE, Prev: CTIME, Up: Intrinsic Procedures ! 7.52 `DATE_AND_TIME' -- Date and time subroutine ================================================ _Description_: *************** _Description_: *** 4579,4585 **** second _Standard_: ! F95 and later _Class_: Subroutine --- 5040,5046 ---- second _Standard_: ! Fortran 95 and later _Class_: Subroutine *************** _Syntax_: *** 4588,4599 **** `CALL DATE_AND_TIME([DATE, TIME, ZONE, VALUES])' _Arguments_: ! DATE (Optional) The type shall be `CHARACTER(8)' or ! larger. ! TIME (Optional) The type shall be `CHARACTER(10)' ! or larger. ! ZONE (Optional) The type shall be `CHARACTER(5)' or ! larger. VALUES (Optional) The type shall be `INTEGER(8)'. _Return value_: --- 5049,5061 ---- `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)'. _Return value_: *************** _See also_: *** 4620,4643 ****  File: gfortran.info, Node: DBLE, Next: DCMPLX, Prev: DATE_AND_TIME, Up: Intrinsic Procedures ! 6.52 `DBLE' -- Double conversion function ========================================= _Description_: ! `DBLE(X)' Converts X to double precision real type. _Standard_: ! F77 and later _Class_: Elemental function _Syntax_: ! `RESULT = DBLE(X)' _Arguments_: ! X The type shall be `INTEGER(*)', `REAL(*)', ! or `COMPLEX(*)'. _Return value_: The return value is of type double precision real. --- 5082,5105 ----  File: gfortran.info, Node: DBLE, Next: DCMPLX, Prev: DATE_AND_TIME, Up: Intrinsic Procedures ! 7.53 `DBLE' -- Double conversion function ========================================= _Description_: ! `DBLE(A)' Converts A to double precision real type. _Standard_: ! Fortran 77 and later _Class_: Elemental function _Syntax_: ! `RESULT = DBLE(A)' _Arguments_: ! A The type shall be `INTEGER', `REAL', or ! `COMPLEX'. _Return value_: The return value is of type double precision real. *************** _See also_: *** 4656,4662 ****  File: gfortran.info, Node: DCMPLX, Next: DFLOAT, Prev: DBLE, Up: Intrinsic Procedures ! 6.53 `DCMPLX' -- Double complex conversion function =================================================== _Description_: --- 5118,5124 ----  File: gfortran.info, Node: DCMPLX, Next: DFLOAT, Prev: DBLE, Up: Intrinsic Procedures ! 7.54 `DCMPLX' -- Double complex conversion function =================================================== _Description_: *************** _Syntax_: *** 4676,4685 **** `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(*)'. _Return value_: The return value is of type `COMPLEX(8)' --- 5138,5147 ---- `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'. _Return value_: The return value is of type `COMPLEX(8)' *************** _Example_: *** 4699,4709 ****  File: gfortran.info, Node: DFLOAT, Next: DIGITS, Prev: DCMPLX, Up: Intrinsic Procedures ! 6.54 `DFLOAT' -- Double conversion function =========================================== _Description_: ! `DFLOAT(X)' Converts X to double precision real type. _Standard_: GNU extension --- 5161,5171 ----  File: gfortran.info, Node: DFLOAT, Next: DIGITS, Prev: DCMPLX, Up: Intrinsic Procedures ! 7.55 `DFLOAT' -- Double conversion function =========================================== _Description_: ! `DFLOAT(A)' Converts A to double precision real type. _Standard_: GNU extension *************** _Class_: *** 4712,4721 **** Elemental function _Syntax_: ! `RESULT = DFLOAT(X)' _Arguments_: ! X The type shall be `INTEGER(*)'. _Return value_: The return value is of type double precision real. --- 5174,5183 ---- Elemental function _Syntax_: ! `RESULT = DFLOAT(A)' _Arguments_: ! A The type shall be `INTEGER'. _Return value_: The return value is of type double precision real. *************** _See also_: *** 4732,4748 ****  File: gfortran.info, Node: DIGITS, Next: DIM, Prev: DFLOAT, Up: Intrinsic Procedures ! 6.55 `DIGITS' -- Significant digits function ! ============================================ _Description_: ! `DIGITS(X)' returns the number of significant 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_: ! F95 and later _Class_: Inquiry function --- 5194,5210 ----  File: gfortran.info, Node: DIGITS, Next: DIM, Prev: DFLOAT, Up: Intrinsic Procedures ! 7.56 `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. _Standard_: ! Fortran 95 and later _Class_: Inquiry function *************** _Syntax_: *** 4751,4757 **** `RESULT = DIGITS(X)' _Arguments_: ! X The type may be `INTEGER(*)' or `REAL(*)'. _Return value_: The return value is of type `INTEGER'. --- 5213,5219 ---- `RESULT = DIGITS(X)' _Arguments_: ! X The type may be `INTEGER' or `REAL'. _Return value_: The return value is of type `INTEGER'. *************** _Example_: *** 4769,4775 ****  File: gfortran.info, Node: DIM, Next: DOT_PRODUCT, Prev: DIGITS, Up: Intrinsic Procedures ! 6.56 `DIM' -- Positive difference ================================= _Description_: --- 5231,5237 ----  File: gfortran.info, Node: DIM, Next: DOT_PRODUCT, Prev: DIGITS, Up: Intrinsic Procedures ! 7.57 `DIM' -- Positive difference ================================= _Description_: *************** _Description_: *** 4777,4783 **** otherwise returns zero. _Standard_: ! F77 and later _Class_: Elemental function --- 5239,5245 ---- otherwise returns zero. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Syntax_: *** 4786,4796 **** `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. _Return value_: ! The return value is of type `INTEGER(*)' or `REAL(*)'. _Example_: program test_dim --- 5248,5258 ---- `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. _Return value_: ! The return value is of type `INTEGER' or `REAL'. _Example_: program test_dim *************** _Example_: *** 4804,4845 **** _Specific names_: Name Argument Return type Standard ! `IDIM(X,Y)' `INTEGER(4) `INTEGER(4)' F77 and later ! X,Y' ! `DDIM(X,Y)' `REAL(8) `REAL(8)' F77 and later ! X,Y'  File: gfortran.info, Node: DOT_PRODUCT, Next: DPROD, Prev: DIM, Up: Intrinsic Procedures ! 6.57 `DOT_PRODUCT' -- Dot product function ========================================== _Description_: ! `DOT_PRODUCT(X,Y)' computes the dot product multiplication of two ! vectors X and Y. 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(X*Y)'. If the ! vectors are `COMPLEX(*)', the result is `SUM(CONJG(X)*Y)'. If the ! vectors are `LOGICAL', the result is `ANY(X.AND.Y)'. _Standard_: ! F95 and later _Class_: Transformational function _Syntax_: ! `RESULT = DOT_PRODUCT(X, Y)' _Arguments_: ! X The type shall be numeric or `LOGICAL', rank 1. ! Y The type shall be numeric or `LOGICAL', rank 1. _Return value_: ! If the arguments are numeric, the return value is a scaler of ! numeric type, `INTEGER(*)', `REAL(*)', or `COMPLEX(*)'. If the ! arguments are `LOGICAL', the return value is `.TRUE.' or `.FALSE.'. _Example_: program test_dot_prod --- 5266,5312 ---- _Specific names_: Name Argument Return type Standard ! `IDIM(X,Y)' `INTEGER(4) `INTEGER(4)' Fortran 77 and ! X,Y' later ! `DDIM(X,Y)' `REAL(8) `REAL(8)' Fortran 77 and ! X,Y' later  File: gfortran.info, Node: DOT_PRODUCT, Next: DPROD, Prev: DIM, Up: Intrinsic Procedures ! 7.58 `DOT_PRODUCT' -- Dot product function ========================================== _Description_: ! `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)'. _Standard_: ! Fortran 95 and later _Class_: Transformational function _Syntax_: ! `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. _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.'. _Example_: program test_dot_prod *************** _Example_: *** 4856,4869 ****  File: gfortran.info, Node: DPROD, Next: DREAL, Prev: DOT_PRODUCT, Up: Intrinsic Procedures ! 6.58 `DPROD' -- Double product function ======================================= _Description_: `DPROD(X,Y)' returns the product `X*Y'. _Standard_: ! F77 and later _Class_: Elemental function --- 5323,5336 ----  File: gfortran.info, Node: DPROD, Next: DREAL, Prev: DOT_PRODUCT, Up: Intrinsic Procedures ! 7.59 `DPROD' -- Double product function ======================================= _Description_: `DPROD(X,Y)' returns the product `X*Y'. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Example_: *** 4890,4896 ****  File: gfortran.info, Node: DREAL, Next: DTIME, Prev: DPROD, Up: Intrinsic Procedures ! 6.59 `DREAL' -- Double real part function ========================================= _Description_: --- 5357,5363 ----  File: gfortran.info, Node: DREAL, Next: DTIME, Prev: DPROD, Up: Intrinsic Procedures ! 7.60 `DREAL' -- Double real part function ========================================= _Description_: *************** _Class_: *** 4903,4912 **** Elemental function _Syntax_: ! `RESULT = DREAL(Z)' _Arguments_: ! Z The type shall be `COMPLEX(8)'. _Return value_: The return value is of type `REAL(8)'. --- 5370,5379 ---- Elemental function _Syntax_: ! `RESULT = DREAL(A)' _Arguments_: ! A The type shall be `COMPLEX(8)'. _Return value_: The return value is of type `REAL(8)'. *************** _See also_: *** 4924,4930 ****  File: gfortran.info, Node: DTIME, Next: EOSHIFT, Prev: DREAL, Up: Intrinsic Procedures ! 6.60 `DTIME' -- Execution time subroutine (or function) ======================================================= _Description_: --- 5391,5397 ----  File: gfortran.info, Node: DTIME, Next: EOSHIFT, Prev: DREAL, Up: Intrinsic Procedures ! 7.61 `DTIME' -- Execution time subroutine (or function) ======================================================= _Description_: *************** _Description_: *** 4945,4951 **** 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, --- 5412,5418 ---- 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, *************** _See also_: *** 5004,5016 ****  File: gfortran.info, Node: EOSHIFT, Next: EPSILON, Prev: DTIME, Up: Intrinsic Procedures ! 6.61 `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 scaler 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 --- 5471,5483 ----  File: gfortran.info, Node: EOSHIFT, Next: EPSILON, Prev: DTIME, Up: Intrinsic Procedures ! 7.62 `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 *************** _Description_: *** 5028,5034 **** Character(LEN)LEN blanks. _Standard_: ! F95 and later _Class_: Transformational function --- 5495,5501 ---- Character(LEN)LEN blanks. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _Syntax_: *** 5037,5043 **** `RESULT = EOSHIFT(ARRAY, SHIFT [, BOUNDARY, DIM])' _Arguments_: ! ARRAY May be any type, not scaler. SHIFT The type shall be `INTEGER'. BOUNDARY Same type as ARRAY. DIM The type shall be `INTEGER'. --- 5504,5510 ---- `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'. *************** _Example_: *** 5062,5075 ****  File: gfortran.info, Node: EPSILON, Next: ERF, Prev: EOSHIFT, Up: Intrinsic Procedures ! 6.62 `EPSILON' -- Epsilon function ================================== _Description_: ! `EPSILON(X)' returns a nearly negligible number relative to `1'. _Standard_: ! F95 and later _Class_: Inquiry function --- 5529,5543 ----  File: gfortran.info, Node: EPSILON, Next: ERF, Prev: EOSHIFT, Up: Intrinsic Procedures ! 7.63 `EPSILON' -- Epsilon function ================================== _Description_: ! `EPSILON(X)' returns the smallest number E of the same kind as X ! such that 1 + E > 1. _Standard_: ! Fortran 95 and later _Class_: Inquiry function *************** _Syntax_: *** 5078,5084 **** `RESULT = EPSILON(X)' _Arguments_: ! X The type shall be `REAL(*)'. _Return value_: The return value is of same type as the argument. --- 5546,5552 ---- `RESULT = EPSILON(X)' _Arguments_: ! X The type shall be `REAL'. _Return value_: The return value is of same type as the argument. *************** _Example_: *** 5094,5107 ****  File: gfortran.info, Node: ERF, Next: ERFC, Prev: EPSILON, Up: Intrinsic Procedures ! 6.63 `ERF' -- Error function ============================ _Description_: `ERF(X)' computes the error function of X. _Standard_: ! GNU Extension _Class_: Elemental function --- 5562,5575 ----  File: gfortran.info, Node: ERF, Next: ERFC, Prev: EPSILON, Up: Intrinsic Procedures ! 7.64 `ERF' -- Error function ============================ _Description_: `ERF(X)' computes the error function of X. _Standard_: ! Fortran 2008 and later _Class_: Elemental function *************** _Syntax_: *** 5110,5121 **** `RESULT = ERF(X)' _Arguments_: ! X The type shall be `REAL(*)', and it shall be ! scalar. _Return value_: ! The return value is a scalar of type `REAL(*)' and it is positive ! ( - 1 \leq erf (x) \leq 1 . _Example_: program test_erf --- 5578,5588 ---- `RESULT = ERF(X)' _Arguments_: ! X The type shall be `REAL'. _Return value_: ! 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_: program test_erf *************** _Specific names_: *** 5128,5143 **** `DERF(X)' `REAL(8) X' `REAL(8)' GNU extension  ! File: gfortran.info, Node: ERFC, Next: ETIME, Prev: ERF, Up: Intrinsic Procedures ! 6.64 `ERFC' -- Error function ============================= _Description_: `ERFC(X)' computes the complementary error function of X. _Standard_: ! GNU extension _Class_: Elemental function --- 5595,5610 ---- `DERF(X)' `REAL(8) X' `REAL(8)' GNU extension  ! File: gfortran.info, Node: ERFC, Next: ERFC_SCALED, Prev: ERF, Up: Intrinsic Procedures ! 7.65 `ERFC' -- Error function ============================= _Description_: `ERFC(X)' computes the complementary error function of X. _Standard_: ! Fortran 2008 and later _Class_: Elemental function *************** _Syntax_: *** 5146,5157 **** `RESULT = ERFC(X)' _Arguments_: ! X The type shall be `REAL(*)', and it shall be ! scalar. _Return value_: ! The return value is a scalar of type `REAL(*)' and it is positive ! ( 0 \leq erfc (x) \leq 2 . _Example_: program test_erfc --- 5613,5623 ---- `RESULT = ERFC(X)' _Arguments_: ! 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 . _Example_: program test_erfc *************** _Specific names_: *** 5164,5172 **** `DERFC(X)' `REAL(8) X' `REAL(8)' GNU extension  ! File: gfortran.info, Node: ETIME, Next: EXIT, Prev: ERFC, Up: Intrinsic Procedures ! 6.65 `ETIME' -- Execution time subroutine (or function) ======================================================= _Description_: --- 5630,5669 ---- `DERFC(X)' `REAL(8) X' `REAL(8)' GNU extension  ! File: gfortran.info, Node: ERFC_SCALED, Next: ETIME, Prev: ERFC, Up: Intrinsic Procedures ! 7.66 `ERFC_SCALED' -- Error function ! ==================================== ! ! _Description_: ! `ERFC_SCALED(X)' computes the exponentially-scaled complementary ! error function of X. ! ! _Standard_: ! Fortran 2008 and later ! ! _Class_: ! Elemental function ! ! _Syntax_: ! `RESULT = ERFC_SCALED(X)' ! ! _Arguments_: ! X The type shall be `REAL'. ! ! _Return value_: ! The return value is of type `REAL' and of the same kind as X. ! ! _Example_: ! program test_erfc_scaled ! real(8) :: x = 0.17_8 ! x = erfc_scaled(x) ! end program test_erfc_scaled ! !  ! File: gfortran.info, Node: ETIME, Next: EXIT, Prev: ERFC_SCALED, Up: Intrinsic Procedures ! ! 7.67 `ETIME' -- Execution time subroutine (or function) ======================================================= _Description_: *************** _See also_: *** 5234,5240 ****  File: gfortran.info, Node: EXIT, Next: EXP, Prev: ETIME, Up: Intrinsic Procedures ! 6.66 `EXIT' -- Exit the program with status. ============================================ _Description_: --- 5731,5737 ----  File: gfortran.info, Node: EXIT, Next: EXP, Prev: ETIME, Up: Intrinsic Procedures ! 7.68 `EXIT' -- Exit the program with status. ============================================ _Description_: *************** _See also_: *** 5270,5283 ****  File: gfortran.info, Node: EXP, Next: EXPONENT, Prev: EXIT, Up: Intrinsic Procedures ! 6.67 `EXP' -- Exponential function ================================== _Description_: `EXP(X)' computes the base e exponential of X. _Standard_: ! F77 and later, has overloads that are GNU extensions _Class_: Elemental function --- 5767,5780 ----  File: gfortran.info, Node: EXP, Next: EXPONENT, Prev: EXIT, Up: Intrinsic Procedures ! 7.69 `EXP' -- Exponential function ================================== _Description_: `EXP(X)' computes the base e exponential of X. _Standard_: ! Fortran 77 and later, has overloads that are GNU extensions _Class_: Elemental function *************** _Syntax_: *** 5286,5292 **** `RESULT = EXP(X)' _Arguments_: ! X The type shall be `REAL(*)' or `COMPLEX(*)'. _Return value_: The return value has same type and kind as X. --- 5783,5789 ---- `RESULT = EXP(X)' _Arguments_: ! X The type shall be `REAL' or `COMPLEX'. _Return value_: The return value has same type and kind as X. *************** _Example_: *** 5299,5307 **** _Specific names_: Name Argument Return type Standard ! `DEXP(X)' `REAL(8) X' `REAL(8)' F77 and later ! `CEXP(X)' `COMPLEX(4) `COMPLEX(4)' F77 and later ! X' `ZEXP(X)' `COMPLEX(8) `COMPLEX(8)' GNU extension X' `CDEXP(X)' `COMPLEX(8) `COMPLEX(8)' GNU extension --- 5796,5805 ---- _Specific names_: Name Argument Return type Standard ! `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 *************** _Specific names_: *** 5310,5316 ****  File: gfortran.info, Node: EXPONENT, Next: FDATE, Prev: EXP, Up: Intrinsic Procedures ! 6.68 `EXPONENT' -- Exponent function ==================================== _Description_: --- 5808,5814 ----  File: gfortran.info, Node: EXPONENT, Next: FDATE, Prev: EXP, Up: Intrinsic Procedures ! 7.70 `EXPONENT' -- Exponent function ==================================== _Description_: *************** _Description_: *** 5318,5324 **** zero the value returned is zero. _Standard_: ! F95 and later _Class_: Elemental function --- 5816,5822 ---- zero the value returned is zero. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Syntax_: *** 5327,5333 **** `RESULT = EXPONENT(X)' _Arguments_: ! X The type shall be `REAL(*)'. _Return value_: The return value is of type default `INTEGER'. --- 5825,5831 ---- `RESULT = EXPONENT(X)' _Arguments_: ! X The type shall be `REAL'. _Return value_: The return value is of type default `INTEGER'. *************** _Example_: *** 5344,5350 ****  File: gfortran.info, Node: FDATE, Next: FGET, Prev: EXPONENT, Up: Intrinsic Procedures ! 6.69 `FDATE' -- Get the current time as a string ================================================ _Description_: --- 5842,5848 ----  File: gfortran.info, Node: FDATE, Next: FGET, Prev: EXPONENT, Up: Intrinsic Procedures ! 7.71 `FDATE' -- Get the current time as a string ================================================ _Description_: *************** _Description_: *** 5354,5360 **** This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. ! DATE is an `INTENT(OUT)' `CHARACTER' variable. _Standard_: GNU extension --- 5852,5858 ---- This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. ! DATE is an `INTENT(OUT)' `CHARACTER' variable of the default kind. _Standard_: GNU extension *************** _Syntax_: *** 5367,5373 **** `DATE = FDATE()', (not recommended). _Arguments_: ! DATE The type shall be of type `CHARACTER'. _Return value_: The current date as a string. --- 5865,5872 ---- `DATE = FDATE()', (not recommended). _Arguments_: ! DATE The type shall be of type `CHARACTER' of the ! default kind _Return value_: The current date as a string. *************** _Example_: *** 5388,5410 ****  File: gfortran.info, Node: FLOAT, Next: FLOOR, Prev: FGETC, Up: Intrinsic Procedures ! 6.70 `FLOAT' -- Convert integer to default real =============================================== _Description_: ! `FLOAT(I)' converts the integer I to a default real value. _Standard_: ! F77 and later _Class_: Elemental function _Syntax_: ! `RESULT = FLOAT(I)' _Arguments_: ! I The type shall be `INTEGER(*)'. _Return value_: The return value is of type default `REAL'. --- 5887,5909 ----  File: gfortran.info, Node: FLOAT, Next: FLOOR, Prev: FGETC, Up: Intrinsic Procedures ! 7.72 `FLOAT' -- Convert integer to default real =============================================== _Description_: ! `FLOAT(A)' converts the integer A to a default real value. _Standard_: ! Fortran 77 and later _Class_: Elemental function _Syntax_: ! `RESULT = FLOAT(A)' _Arguments_: ! A The type shall be `INTEGER'. _Return value_: The return value is of type default `REAL'. *************** _See also_: *** 5421,5427 ****  File: gfortran.info, Node: FGET, Next: FGETC, Prev: FDATE, Up: Intrinsic Procedures ! 6.71 `FGET' -- Read a single character in stream mode from stdin ================================================================ _Description_: --- 5920,5926 ----  File: gfortran.info, Node: FGET, Next: FGETC, Prev: FDATE, Up: Intrinsic Procedures ! 7.73 `FGET' -- Read a single character in stream mode from stdin ================================================================ _Description_: *************** _Syntax_: *** 5449,5458 **** `CALL FGET(C [, STATUS])' _Arguments_: ! C The type shall be `CHARACTER'. 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_: --- 5948,5957 ---- `CALL FGET(C [, STATUS])' _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. _Example_: *************** _See also_: *** 5476,5482 ****  File: gfortran.info, Node: FGETC, Next: FLOAT, Prev: FGET, Up: Intrinsic Procedures ! 6.72 `FGETC' -- Read a single character in stream mode ====================================================== _Description_: --- 5975,5981 ----  File: gfortran.info, Node: FGETC, Next: FLOAT, Prev: FGET, Up: Intrinsic Procedures ! 7.74 `FGETC' -- Read a single character in stream mode ====================================================== _Description_: *************** _Syntax_: *** 5505,5515 **** _Arguments_: UNIT The type shall be `INTEGER'. ! C The type shall be `CHARACTER'. 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 --- 6004,6014 ---- _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. _Example_: PROGRAM test_fgetc *************** _See also_: *** 5531,5559 ****  File: gfortran.info, Node: FLOOR, Next: FLUSH, Prev: FLOAT, Up: Intrinsic Procedures ! 6.73 `FLOOR' -- Integer floor function ====================================== _Description_: ! `FLOOR(X)' returns the greatest integer less than or equal to X. _Standard_: ! F95 and later _Class_: Elemental function _Syntax_: ! `RESULT = FLOOR(X [, KIND])' _Arguments_: ! X 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)' _Example_: program test_floor --- 6030,6059 ----  File: gfortran.info, Node: FLOOR, Next: FLUSH, Prev: FLOAT, Up: Intrinsic Procedures ! 7.75 `FLOOR' -- Integer floor function ====================================== _Description_: ! `FLOOR(A)' returns the greatest integer less than or equal to X. _Standard_: ! Fortran 95 and later _Class_: Elemental function _Syntax_: ! `RESULT = FLOOR(A [, KIND])' _Arguments_: ! 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. _Example_: program test_floor *************** _See also_: *** 5570,5576 ****  File: gfortran.info, Node: FLUSH, Next: FNUM, Prev: FLOOR, Up: Intrinsic Procedures ! 6.74 `FLUSH' -- Flush I/O unit(s) ================================= _Description_: --- 6070,6076 ----  File: gfortran.info, Node: FLUSH, Next: FNUM, Prev: FLOOR, Up: Intrinsic Procedures ! 7.76 `FLUSH' -- Flush I/O unit(s) ================================= _Description_: *************** _Note_: *** 5598,5604 ****  File: gfortran.info, Node: FNUM, Next: FPUT, Prev: FLUSH, Up: Intrinsic Procedures ! 6.75 `FNUM' -- File number function =================================== _Description_: --- 6098,6104 ----  File: gfortran.info, Node: FNUM, Next: FPUT, Prev: FLUSH, Up: Intrinsic Procedures ! 7.77 `FNUM' -- File number function =================================== _Description_: *************** _Example_: *** 5632,5638 ****  File: gfortran.info, Node: FPUT, Next: FPUTC, Prev: FNUM, Up: Intrinsic Procedures ! 6.76 `FPUT' -- Write a single character in stream mode to stdout ================================================================ _Description_: --- 6132,6138 ----  File: gfortran.info, Node: FPUT, Next: FPUTC, Prev: FNUM, Up: Intrinsic Procedures ! 7.78 `FPUT' -- Write a single character in stream mode to stdout ================================================================ _Description_: *************** _Syntax_: *** 5660,5670 **** `CALL FPUT(C [, STATUS])' _Arguments_: ! C The type shall be `CHARACTER'. 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 --- 6160,6170 ---- `CALL FPUT(C [, STATUS])' _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. _Example_: PROGRAM test_fput *************** _See also_: *** 5681,5687 ****  File: gfortran.info, Node: FPUTC, Next: FRACTION, Prev: FPUT, Up: Intrinsic Procedures ! 6.77 `FPUTC' -- Write a single character in stream mode ======================================================= _Description_: --- 6181,6187 ----  File: gfortran.info, Node: FPUTC, Next: FRACTION, Prev: FPUT, Up: Intrinsic Procedures ! 7.79 `FPUTC' -- Write a single character in stream mode ======================================================= _Description_: *************** _Syntax_: *** 5710,5720 **** _Arguments_: UNIT The type shall be `INTEGER'. ! C The type shall be `CHARACTER'. 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 --- 6210,6220 ---- _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. _Example_: PROGRAM test_fputc *************** _See also_: *** 5734,5740 ****  File: gfortran.info, Node: FRACTION, Next: FREE, Prev: FPUTC, Up: Intrinsic Procedures ! 6.78 `FRACTION' -- Fractional part of the model representation ============================================================== _Description_: --- 6234,6240 ----  File: gfortran.info, Node: FRACTION, Next: FREE, Prev: FPUTC, Up: Intrinsic Procedures ! 7.80 `FRACTION' -- Fractional part of the model representation ============================================================== _Description_: *************** _Description_: *** 5742,5748 **** representation of `X'. _Standard_: ! F95 and later _Class_: Elemental function --- 6242,6248 ---- representation of `X'. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Example_: *** 5769,5775 ****  File: gfortran.info, Node: FREE, Next: FSEEK, Prev: FRACTION, Up: Intrinsic Procedures ! 6.79 `FREE' -- Frees memory =========================== _Description_: --- 6269,6275 ----  File: gfortran.info, Node: FREE, Next: FSEEK, Prev: FRACTION, Up: Intrinsic Procedures ! 7.81 `FREE' -- Frees memory =========================== _Description_: *************** _See also_: *** 5805,5811 ****  File: gfortran.info, Node: FSEEK, Next: FSTAT, Prev: FREE, Up: Intrinsic Procedures ! 6.80 `FSEEK' -- Low level file positioning subroutine ===================================================== _Description_: --- 6305,6311 ----  File: gfortran.info, Node: FSEEK, Next: FSTAT, Prev: FREE, Up: Intrinsic Procedures ! 7.82 `FSEEK' -- Low level file positioning subroutine ===================================================== _Description_: *************** _See also_: *** 5875,5881 ****  File: gfortran.info, Node: FSTAT, Next: FTELL, Prev: FSEEK, Up: Intrinsic Procedures ! 6.81 `FSTAT' -- Get file status =============================== _Description_: --- 6375,6381 ----  File: gfortran.info, Node: FSTAT, Next: FTELL, Prev: FSEEK, Up: Intrinsic Procedures ! 7.83 `FSTAT' -- Get file status =============================== _Description_: *************** _Arguments_: *** 5900,5907 **** UNIT An open I/O unit number of type `INTEGER'. BUFF 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. --- 6400,6407 ---- UNIT An open I/O unit number of type `INTEGER'. BUFF 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. *************** _See also_: *** 5912,5918 ****  File: gfortran.info, Node: FTELL, Next: GAMMA, Prev: FSTAT, Up: Intrinsic Procedures ! 6.82 `FTELL' -- Current stream position ======================================= _Description_: --- 6412,6418 ----  File: gfortran.info, Node: FTELL, Next: GAMMA, Prev: FSTAT, Up: Intrinsic Procedures ! 7.84 `FTELL' -- Current stream position ======================================= _Description_: *************** _See also_: *** 5953,5959 ****  File: gfortran.info, Node: GAMMA, Next: GERROR, Prev: FTELL, Up: Intrinsic Procedures ! 6.83 `GAMMA' -- Gamma function ============================== _Description_: --- 6453,6459 ----  File: gfortran.info, Node: GAMMA, Next: GERROR, Prev: FTELL, Up: Intrinsic Procedures ! 7.85 `GAMMA' -- Gamma function ============================== _Description_: *************** _Description_: *** 5962,5968 **** function \Gamma(x)=(x-1)!. _Standard_: ! GNU Extension _Class_: Elemental function --- 6462,6468 ---- function \Gamma(x)=(x-1)!. _Standard_: ! Fortran 2008 and later _Class_: Elemental function *************** _Specific names_: *** 5989,6001 **** `DGAMMA(X)' `REAL(8) X' `REAL(8)' GNU Extension _See also_: ! Logarithm of the Gamma function: *note LGAMMA::  File: gfortran.info, Node: GERROR, Next: GETARG, Prev: GAMMA, Up: Intrinsic Procedures ! 6.84 `GERROR' -- Get last system error message ============================================== _Description_: --- 6489,6501 ---- `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 ! 7.86 `GERROR' -- Get last system error message ============================================== _Description_: *************** _Syntax_: *** 6012,6018 **** `CALL GERROR(RESULT)' _Arguments_: ! RESULT Shall of type `CHARACTER(*)'. _Example_: PROGRAM test_gerror --- 6512,6518 ---- `CALL GERROR(RESULT)' _Arguments_: ! RESULT Shall of type `CHARACTER' and of default _Example_: PROGRAM test_gerror *************** _See also_: *** 6027,6038 ****  File: gfortran.info, Node: GETARG, Next: GET_COMMAND, Prev: GERROR, Up: Intrinsic Procedures ! 6.85 `GETARG' -- Get command line arguments =========================================== _Description_: ! Retrieve the Nth argument that was passed on the command line when ! the containing program was invoked. This intrinsic routine is provided for backwards compatibility with GNU Fortran 77. In new code, programmers should consider the use --- 6527,6538 ----  File: gfortran.info, Node: GETARG, Next: GET_COMMAND, Prev: GERROR, Up: Intrinsic Procedures ! 7.87 `GETARG' -- Get command line arguments =========================================== _Description_: ! Retrieve the POS-th argument that was passed on the command line ! when the containing program was invoked. This intrinsic routine is provided for backwards compatibility with GNU Fortran 77. In new code, programmers should consider the use *************** _Syntax_: *** 6051,6057 **** _Arguments_: POS Shall be of type `INTEGER' and not wider than the default integer kind; POS \geq 0 ! VALUE Shall be of type `CHARACTER(*)'. _Return value_: After `GETARG' returns, the VALUE argument holds the POSth command --- 6551,6559 ---- _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'. _Return value_: After `GETARG' returns, the VALUE argument holds the POSth command *************** _Example_: *** 6075,6087 **** _See also_: GNU Fortran 77 compatibility function: *note IARGC:: ! F2003 functions and subroutines: *note GET_COMMAND::, *note GET_COMMAND_ARGUMENT::, *note COMMAND_ARGUMENT_COUNT::  File: gfortran.info, Node: GET_COMMAND, Next: GET_COMMAND_ARGUMENT, Prev: GETARG, Up: Intrinsic Procedures ! 6.86 `GET_COMMAND' -- Get the entire command line ================================================= _Description_: --- 6577,6589 ---- _See also_: GNU Fortran 77 compatibility function: *note IARGC:: ! Fortran 2003 functions and subroutines: *note GET_COMMAND::, *note GET_COMMAND_ARGUMENT::, *note COMMAND_ARGUMENT_COUNT::  File: gfortran.info, Node: GET_COMMAND, Next: GET_COMMAND_ARGUMENT, Prev: GETARG, Up: Intrinsic Procedures ! 7.88 `GET_COMMAND' -- Get the entire command line ================================================= _Description_: *************** _Description_: *** 6089,6108 **** program. _Standard_: ! F2003 _Class_: Subroutine _Syntax_: ! `CALL GET_COMMAND(CMD)' _Arguments_: ! CMD Shall be of type `CHARACTER(*)'. _Return value_: Stores the entire command line that was used to invoke the program ! in ARG. If ARG is not large enough, the command will be truncated. _Example_: PROGRAM test_get_command --- 6591,6612 ---- program. _Standard_: ! Fortran 2003 and later _Class_: Subroutine _Syntax_: ! `CALL GET_COMMAND(COMMAND)' _Arguments_: ! COMMAND Shall be of type `CHARACTER' and of default ! kind. _Return value_: Stores the entire command line that was used to invoke the program ! in COMMAND. If COMMAND is not large enough, the command will be ! truncated. _Example_: PROGRAM test_get_command *************** _See also_: *** 6117,6149 ****  File: gfortran.info, Node: GET_COMMAND_ARGUMENT, Next: GETCWD, Prev: GET_COMMAND, Up: Intrinsic Procedures ! 6.87 `GET_COMMAND_ARGUMENT' -- Get command line arguments ========================================================= _Description_: ! Retrieve the Nth argument that was passed on the command line when ! the containing program was invoked. _Standard_: ! F2003 _Class_: Subroutine _Syntax_: ! `CALL GET_COMMAND_ARGUMENT(N, ARG)' _Arguments_: ! N Shall be of type `INTEGER(4)', N \geq 0 ! ARG Shall be of type `CHARACTER(*)'. _Return value_: ! After `GET_COMMAND_ARGUMENT' returns, the ARG argument holds the ! Nth command line argument. If ARG can not hold the argument, it is ! truncated to fit the length of ARG. If there are less than N ! arguments specified at the command line, ARG will be filled with ! blanks. If N = 0, ARG is set to the name of the program (on ! systems that support this feature). _Example_: PROGRAM test_get_command_argument --- 6621,6663 ----  File: gfortran.info, Node: GET_COMMAND_ARGUMENT, Next: GETCWD, Prev: GET_COMMAND, Up: Intrinsic Procedures ! 7.89 `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. _Standard_: ! Fortran 2003 and later _Class_: Subroutine _Syntax_: ! `CALL GET_COMMAND_ARGUMENT(NUMBER [, VALUE, LENGTH, STATUS])' _Arguments_: ! NUMBER Shall be a scalar of type `INTEGER(4)', NUMBER ! \geq 0 ! VALUE Shall be a scalar of type `CHARACTER' and of ! default kind. ! LENGTH (Option) Shall be a scalar of type ! `INTEGER(4)'. ! STATUS (Option) Shall be a scalar of type ! `INTEGER(4)'. _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 ! 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 ! 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. _Example_: PROGRAM test_get_command_argument *************** _See also_: *** 6166,6172 ****  File: gfortran.info, Node: GETCWD, Next: GETENV, Prev: GET_COMMAND_ARGUMENT, Up: Intrinsic Procedures ! 6.88 `GETCWD' -- Get current working directory ============================================== _Description_: --- 6680,6686 ----  File: gfortran.info, Node: GETCWD, Next: GETENV, Prev: GET_COMMAND_ARGUMENT, Up: Intrinsic Procedures ! 7.90 `GETCWD' -- Get current working directory ============================================== _Description_: *************** _Class_: *** 6182,6194 **** Subroutine, function _Syntax_: ! `CALL GETCWD(CWD [, STATUS])' _Arguments_: ! CWD The type shall be `CHARACTER(*)'. STATUS (Optional) status flag. Returns 0 on success, ! a system specific and ! nonzero error code otherwise. _Example_: PROGRAM test_getcwd --- 6696,6709 ---- Subroutine, function _Syntax_: ! `CALL GETCWD(C [, STATUS])' _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. _Example_: PROGRAM test_getcwd *************** _See also_: *** 6203,6213 ****  File: gfortran.info, Node: GETENV, Next: GET_ENVIRONMENT_VARIABLE, Prev: GETCWD, Up: Intrinsic Procedures ! 6.89 `GETENV' -- Get an environmental variable ============================================== _Description_: ! Get the VALUE of the environmental variable ENVVAR. This intrinsic routine is provided for backwards compatibility with GNU Fortran 77. In new code, programmers should consider the use --- 6718,6728 ----  File: gfortran.info, Node: GETENV, Next: GET_ENVIRONMENT_VARIABLE, Prev: GETCWD, Up: Intrinsic Procedures ! 7.91 `GETENV' -- Get an environmental variable ============================================== _Description_: ! Get the VALUE of the environmental variable NAME. This intrinsic routine is provided for backwards compatibility with GNU Fortran 77. In new code, programmers should consider the use *************** _Class_: *** 6221,6236 **** Subroutine _Syntax_: ! `CALL GETENV(ENVVAR, VALUE)' _Arguments_: ! ENVVAR Shall be of type `CHARACTER(*)'. ! VALUE Shall be of type `CHARACTER(*)'. _Return value_: ! Stores the value of ENVVAR in VALUE. If VALUE is not large enough ! to hold the data, it is truncated. If ENVVAR is not set, VALUE ! will be filled with blanks. _Example_: PROGRAM test_getenv --- 6736,6753 ---- Subroutine _Syntax_: ! `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. _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. _Example_: PROGRAM test_getenv *************** _See also_: *** 6245,6273 ****  File: gfortran.info, Node: GET_ENVIRONMENT_VARIABLE, Next: GETGID, Prev: GETENV, Up: Intrinsic Procedures ! 6.90 `GET_ENVIRONMENT_VARIABLE' -- Get an environmental variable ================================================================ _Description_: ! Get the VALUE of the environmental variable ENVVAR. _Standard_: ! F2003 _Class_: Subroutine _Syntax_: ! `CALL GET_ENVIRONMENT_VARIABLE(ENVVAR, VALUE)' _Arguments_: ! ENVVAR Shall be of type `CHARACTER(*)'. ! VALUE Shall be of type `CHARACTER(*)'. _Return value_: ! Stores the value of ENVVAR in VALUE. If VALUE is not large enough ! to hold the data, it is truncated. If ENVVAR is not set, VALUE ! will be filled with blanks. _Example_: PROGRAM test_getenv --- 6762,6802 ----  File: gfortran.info, Node: GET_ENVIRONMENT_VARIABLE, Next: GETGID, Prev: GETENV, Up: Intrinsic Procedures ! 7.92 `GET_ENVIRONMENT_VARIABLE' -- Get an environmental variable ================================================================ _Description_: ! Get the VALUE of the environmental variable NAME. _Standard_: ! Fortran 2003 and later _Class_: Subroutine _Syntax_: ! `CALL GET_ENVIRONMENT_VARIABLE(NAME[, VALUE, LENGTH, STATUS, ! TRIM_NAME)' _Arguments_: ! NAME Shall be a scalar of type `CHARACTER(1)'. ! VALUE Shall be a scalar of type `CHARACTER(1)'. ! LENGTH Shall be a scalar of type `INTEGER(4)'. ! STATUS Shall be a scalar of type `INTEGER(4)'. ! TRIM_NAME Shall be a scalar of type `LOGICAL(4)'. _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. _Example_: PROGRAM test_getenv *************** _Example_: *** 6279,6285 ****  File: gfortran.info, Node: GETGID, Next: GETLOG, Prev: GET_ENVIRONMENT_VARIABLE, Up: Intrinsic Procedures ! 6.91 `GETGID' -- Group ID function ================================== _Description_: --- 6808,6814 ----  File: gfortran.info, Node: GETGID, Next: GETLOG, Prev: GET_ENVIRONMENT_VARIABLE, Up: Intrinsic Procedures ! 7.93 `GETGID' -- Group ID function ================================== _Description_: *************** _See also_: *** 6306,6312 ****  File: gfortran.info, Node: GETLOG, Next: GETPID, Prev: GETGID, Up: Intrinsic Procedures ! 6.92 `GETLOG' -- Get login name =============================== _Description_: --- 6835,6841 ----  File: gfortran.info, Node: GETLOG, Next: GETPID, Prev: GETGID, Up: Intrinsic Procedures ! 7.94 `GETLOG' -- Get login name =============================== _Description_: *************** _Class_: *** 6319,6328 **** Subroutine _Syntax_: ! `CALL GETLOG(LOGIN)' _Arguments_: ! LOGIN Shall be of type `CHARACTER(*)'. _Return value_: Stores the current user name in LOGIN. (On systems where POSIX --- 6848,6858 ---- Subroutine _Syntax_: ! `CALL GETLOG(C)' _Arguments_: ! C Shall be of type `CHARACTER' and of default ! kind. _Return value_: Stores the current user name in LOGIN. (On systems where POSIX *************** _See also_: *** 6343,6349 ****  File: gfortran.info, Node: GETPID, Next: GETUID, Prev: GETLOG, Up: Intrinsic Procedures ! 6.93 `GETPID' -- Process ID function ==================================== _Description_: --- 6873,6879 ----  File: gfortran.info, Node: GETPID, Next: GETUID, Prev: GETLOG, Up: Intrinsic Procedures ! 7.95 `GETPID' -- Process ID function ==================================== _Description_: *************** _See also_: *** 6374,6380 ****  File: gfortran.info, Node: GETUID, Next: GMTIME, Prev: GETPID, Up: Intrinsic Procedures ! 6.94 `GETUID' -- User ID function ================================= _Description_: --- 6904,6910 ----  File: gfortran.info, Node: GETUID, Next: GMTIME, Prev: GETPID, Up: Intrinsic Procedures ! 7.96 `GETUID' -- User ID function ================================= _Description_: *************** _See also_: *** 6401,6412 ****  File: gfortran.info, Node: GMTIME, Next: HOSTNM, Prev: GETUID, Up: Intrinsic Procedures ! 6.95 `GMTIME' -- Convert time to GMT info ========================================= _Description_: ! Given a system time value STIME (as provided by the `TIME8()' ! intrinsic), fills TARRAY 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)'. --- 6931,6942 ----  File: gfortran.info, Node: GMTIME, Next: HOSTNM, Prev: GETUID, Up: Intrinsic Procedures ! 7.97 `GMTIME' -- Convert time to GMT info ========================================= _Description_: ! Given a system time value TIME (as provided by the `TIME8()' ! 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)'. *************** _Class_: *** 6417,6435 **** Subroutine _Syntax_: ! `CALL GMTIME(STIME, TARRAY)' _Arguments_: ! STIME An `INTEGER(*)' scalar expression ! corresponding to a system time, with ! `INTENT(IN)'. ! TARRAY A default `INTEGER' array with 9 elements, ! with `INTENT(OUT)'. _Return value_: ! The elements of TARRAY 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 --- 6947,6964 ---- Subroutine _Syntax_: ! `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)'. _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 *************** _Return value_: *** 6446,6453 **** 8. Days since January 1 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:: --- 6975,6982 ---- 8. Days since January 1 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:: *************** _See also_: *** 6456,6462 ****  File: gfortran.info, Node: HOSTNM, Next: HUGE, Prev: GMTIME, Up: Intrinsic Procedures ! 6.96 `HOSTNM' -- Get system host name ===================================== _Description_: --- 6985,6991 ----  File: gfortran.info, Node: HOSTNM, Next: HUGE, Prev: GMTIME, Up: Intrinsic Procedures ! 7.98 `HOSTNM' -- Get system host name ===================================== _Description_: *************** _Class_: *** 6473,6487 **** Subroutine, function _Syntax_: ! `CALL HOSTNM(NAME[, STATUS])' `STATUS = HOSTNM(NAME)' _Arguments_: ! NAME Shall of type `CHARACTER(*)'. 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 --- 7002,7015 ---- Subroutine, function _Syntax_: ! `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. _Return value_: In either syntax, NAME is set to the current hostname if it can be *************** _Return value_: *** 6489,6497 ****  ! File: gfortran.info, Node: HUGE, Next: IACHAR, Prev: HOSTNM, Up: Intrinsic Procedures ! 6.97 `HUGE' -- Largest number of a kind ======================================= _Description_: --- 7017,7025 ----  ! File: gfortran.info, Node: HUGE, Next: HYPOT, Prev: HOSTNM, Up: Intrinsic Procedures ! 7.99 `HUGE' -- Largest number of a kind ======================================= _Description_: *************** _Description_: *** 6499,6505 **** the model of the type of `X'. _Standard_: ! F95 and later _Class_: Inquiry function --- 7027,7033 ---- the model of the type of `X'. _Standard_: ! Fortran 95 and later _Class_: Inquiry function *************** _Example_: *** 6520,6536 **** end program test_huge_tiny  ! File: gfortran.info, Node: IACHAR, Next: IAND, Prev: HUGE, Up: Intrinsic Procedures ! 6.98 `IACHAR' -- Code in ASCII collating sequence ! ================================================= _Description_: `IACHAR(C)' returns the code for the ASCII character in the first character position of `C'. _Standard_: ! F95 and later _Class_: Elemental function --- 7048,7097 ---- end program test_huge_tiny  ! File: gfortran.info, Node: HYPOT, Next: IACHAR, Prev: HUGE, Up: Intrinsic Procedures ! 7.100 `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. ! ! _Standard_: ! Fortran 2008 and later ! ! _Class_: ! Elemental function ! ! _Syntax_: ! `RESULT = HYPOT(X, Y)' ! ! _Arguments_: ! 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. ! ! _Example_: ! program test_hypot ! real(4) :: x = 1.e0_4, y = 0.5e0_4 ! x = hypot(x,y) ! end program test_hypot ! !  ! File: gfortran.info, Node: IACHAR, Next: IAND, Prev: HYPOT, Up: Intrinsic Procedures ! ! 7.101 `IACHAR' -- Code in ASCII collating sequence ! ================================================== _Description_: `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 _Class_: Elemental function *************** _Arguments_: *** 6542,6549 **** 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 --- 7103,7110 ---- 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 *************** _See also_: *** 6566,6579 ****  File: gfortran.info, Node: IAND, Next: IARGC, Prev: IACHAR, Up: Intrinsic Procedures ! 6.99 `IAND' -- Bitwise logical and ! ================================== _Description_: Bitwise logical `AND'. _Standard_: ! F95 and later _Class_: Elemental function --- 7127,7140 ----  File: gfortran.info, Node: IAND, Next: IARGC, Prev: IACHAR, Up: Intrinsic Procedures ! 7.102 `IAND' -- Bitwise logical and ! =================================== _Description_: Bitwise logical `AND'. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Syntax_: *** 6582,6596 **** `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.) _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.) _Example_: PROGRAM test_iand --- 7143,7157 ---- `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.) _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.) _Example_: PROGRAM test_iand *************** _See also_: *** 6607,6613 ****  File: gfortran.info, Node: IARGC, Next: IBCLR, Prev: IAND, Up: Intrinsic Procedures ! 6.100 `IARGC' -- Get the number of command line arguments ========================================================= _Description_: --- 7168,7174 ----  File: gfortran.info, Node: IARGC, Next: IBCLR, Prev: IAND, Up: Intrinsic Procedures ! 7.103 `IARGC' -- Get the number of command line arguments ========================================================= _Description_: *************** _Example_: *** 6640,6652 **** _See also_: GNU Fortran 77 compatibility subroutine: *note GETARG:: ! F2003 functions and subroutines: *note GET_COMMAND::, *note GET_COMMAND_ARGUMENT::, *note COMMAND_ARGUMENT_COUNT::  File: gfortran.info, Node: IBCLR, Next: IBITS, Prev: IARGC, Up: Intrinsic Procedures ! 6.101 `IBCLR' -- Clear bit ========================== _Description_: --- 7201,7213 ---- _See also_: GNU Fortran 77 compatibility subroutine: *note GETARG:: ! Fortran 2003 functions and subroutines: *note GET_COMMAND::, *note GET_COMMAND_ARGUMENT::, *note COMMAND_ARGUMENT_COUNT::  File: gfortran.info, Node: IBCLR, Next: IBITS, Prev: IARGC, Up: Intrinsic Procedures ! 7.104 `IBCLR' -- Clear bit ========================== _Description_: *************** _Description_: *** 6654,6660 **** zero. _Standard_: ! F95 and later _Class_: Elemental function --- 7215,7221 ---- zero. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Syntax_: *** 6663,6673 **** `RESULT = IBCLR(I, POS)' _Arguments_: ! 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. _See also_: *note IBITS::, *note IBSET::, *note IAND::, *note IOR::, *note --- 7224,7234 ---- `RESULT = IBCLR(I, POS)' _Arguments_: ! 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. _See also_: *note IBITS::, *note IBSET::, *note IAND::, *note IOR::, *note *************** _See also_: *** 6677,6683 ****  File: gfortran.info, Node: IBITS, Next: IBSET, Prev: IBCLR, Up: Intrinsic Procedures ! 6.102 `IBITS' -- Bit extraction =============================== _Description_: --- 7238,7244 ----  File: gfortran.info, Node: IBITS, Next: IBSET, Prev: IBCLR, Up: Intrinsic Procedures ! 7.105 `IBITS' -- Bit extraction =============================== _Description_: *************** _Description_: *** 6687,6693 **** `POS+LEN' must be less than or equal to the value `BIT_SIZE(I)'. _Standard_: ! F95 and later _Class_: Elemental function --- 7248,7254 ---- `POS+LEN' must be less than or equal to the value `BIT_SIZE(I)'. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Syntax_: *** 6696,6707 **** `RESULT = IBITS(I, POS, LEN)' _Arguments_: ! 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. _See also_: *note BIT_SIZE::, *note IBCLR::, *note IBSET::, *note IAND::, --- 7257,7268 ---- `RESULT = IBITS(I, POS, LEN)' _Arguments_: ! 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. _See also_: *note BIT_SIZE::, *note IBCLR::, *note IBSET::, *note IAND::, *************** _See also_: *** 6710,6716 ****  File: gfortran.info, Node: IBSET, Next: ICHAR, Prev: IBITS, Up: Intrinsic Procedures ! 6.103 `IBSET' -- Set bit ======================== _Description_: --- 7271,7277 ----  File: gfortran.info, Node: IBSET, Next: ICHAR, Prev: IBITS, Up: Intrinsic Procedures ! 7.106 `IBSET' -- Set bit ======================== _Description_: *************** _Description_: *** 6718,6724 **** one. _Standard_: ! F95 and later _Class_: Elemental function --- 7279,7285 ---- one. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Syntax_: *** 6727,6737 **** `RESULT = IBSET(I, POS)' _Arguments_: ! 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. _See also_: *note IBCLR::, *note IBITS::, *note IAND::, *note IOR::, *note --- 7288,7298 ---- `RESULT = IBSET(I, POS)' _Arguments_: ! 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. _See also_: *note IBCLR::, *note IBITS::, *note IAND::, *note IOR::, *note *************** _See also_: *** 6741,6747 ****  File: gfortran.info, Node: ICHAR, Next: IDATE, Prev: IBSET, Up: Intrinsic Procedures ! 6.104 `ICHAR' -- Character-to-integer conversion function ========================================================= _Description_: --- 7302,7308 ----  File: gfortran.info, Node: ICHAR, Next: IDATE, Prev: IBSET, Up: Intrinsic Procedures ! 7.107 `ICHAR' -- Character-to-integer conversion function ========================================================= _Description_: *************** _Description_: *** 6751,6757 **** necessarily the same across different GNU Fortran implementations. _Standard_: ! F95 and later _Class_: Elemental function --- 7312,7318 ---- necessarily the same across different GNU Fortran implementations. _Standard_: ! Fortan 95 and later, with KIND argument Fortran 2003 and later _Class_: Elemental function *************** _Arguments_: *** 6763,6770 **** 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 --- 7324,7331 ---- 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 *************** _See also_: *** 6803,6809 ****  File: gfortran.info, Node: IDATE, Next: IEOR, Prev: ICHAR, Up: Intrinsic Procedures ! 6.105 `IDATE' -- Get current local time subroutine (day/month/year) =================================================================== _Description_: --- 7364,7370 ----  File: gfortran.info, Node: IDATE, Next: IEOR, Prev: ICHAR, Up: Intrinsic Procedures ! 7.108 `IDATE' -- Get current local time subroutine (day/month/year) =================================================================== _Description_: *************** _Class_: *** 6819,6832 **** Subroutine _Syntax_: ! `CALL IDATE(TARRAY)' _Arguments_: ! TARRAY The type shall be `INTEGER, DIMENSION(3)' and the kind shall be the default integer kind. _Return value_: ! Does not return. _Example_: program test_idate --- 7380,7393 ---- Subroutine _Syntax_: ! `CALL IDATE(VALUES)' _Arguments_: ! VALUES The type shall be `INTEGER, DIMENSION(3)' and the kind shall be the default integer kind. _Return value_: ! Does not return anything. _Example_: program test_idate *************** _Example_: *** 6840,6853 ****  File: gfortran.info, Node: IEOR, Next: IERRNO, Prev: IDATE, Up: Intrinsic Procedures ! 6.106 `IEOR' -- Bitwise logical exclusive or ============================================ _Description_: `IEOR' returns the bitwise boolean exclusive-OR of I and J. _Standard_: ! F95 and later _Class_: Elemental function --- 7401,7414 ----  File: gfortran.info, Node: IEOR, Next: IERRNO, Prev: IDATE, Up: Intrinsic Procedures ! 7.109 `IEOR' -- Bitwise logical exclusive or ============================================ _Description_: `IEOR' returns the bitwise boolean exclusive-OR of I and J. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Syntax_: *** 6856,6870 **** `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.) _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.) _See also_: *note IOR::, *note IAND::, *note IBITS::, *note IBSET::, *note --- 7417,7431 ---- `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.) _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.) _See also_: *note IOR::, *note IAND::, *note IBITS::, *note IBSET::, *note *************** _See also_: *** 6873,6879 ****  File: gfortran.info, Node: IERRNO, Next: INDEX intrinsic, Prev: IEOR, Up: Intrinsic Procedures ! 6.107 `IERRNO' -- Get the last system error number ================================================== _Description_: --- 7434,7440 ----  File: gfortran.info, Node: IERRNO, Next: INDEX intrinsic, Prev: IEOR, Up: Intrinsic Procedures ! 7.110 `IERRNO' -- Get the last system error number ================================================== _Description_: *************** _See also_: *** 6902,6908 ****  File: gfortran.info, Node: INDEX intrinsic, Next: INT, Prev: IERRNO, Up: Intrinsic Procedures ! 6.108 `INDEX' -- Position of a substring within a string ======================================================== _Description_: --- 7463,7469 ----  File: gfortran.info, Node: INDEX intrinsic, Next: INT, Prev: IERRNO, Up: Intrinsic Procedures ! 7.111 `INDEX' -- Position of a substring within a string ======================================================== _Description_: *************** _Description_: *** 6913,6919 **** last occurrence rather than the first. _Standard_: ! F77 and later _Class_: Elemental function --- 7474,7480 ---- last occurrence rather than the first. _Standard_: ! Fortran 77 and later, with KIND argument Fortran 2003 and later _Class_: Elemental function *************** _Syntax_: *** 6922,6936 **** `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. _Return value_: The return value is of type `INTEGER' and of kind KIND. If KIND is --- 7483,7497 ---- `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. _Return value_: The return value is of type `INTEGER' and of kind KIND. If KIND is *************** _See also_: *** 6942,6955 ****  File: gfortran.info, Node: INT, Next: INT2, Prev: INDEX intrinsic, Up: Intrinsic Procedures ! 6.109 `INT' -- Convert to integer type ====================================== _Description_: Convert to integer type _Standard_: ! F77 and later _Class_: Elemental function --- 7503,7516 ----  File: gfortran.info, Node: INT, Next: INT2, Prev: INDEX intrinsic, Up: Intrinsic Procedures ! 7.112 `INT' -- Convert to integer type ====================================== _Description_: Convert to integer type _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Syntax_: *** 6958,6985 **** `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. _Return value_: ! 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)' equals the largest integer that does not exceed the range 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 of A. _Example_: program test_int --- 7519,7546 ---- `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. _Return value_: ! 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)' equals the largest integer that does not exceed the range 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 ! of A. _Example_: program test_int *************** _Example_: *** 6991,7004 **** _Specific names_: Name Argument Return type Standard ! `IFIX(A)' `REAL(4) A' `INTEGER' F77 and later ! `IDINT(A)' `REAL(8) A' `INTEGER' F77 and later  File: gfortran.info, Node: INT2, Next: INT8, Prev: INT, Up: Intrinsic Procedures ! 6.110 `INT2' -- Convert to 16-bit integer type ============================================== _Description_: --- 7552,7567 ---- _Specific names_: Name Argument Return type Standard ! `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 ! 7.113 `INT2' -- Convert to 16-bit integer type ============================================== _Description_: *************** _Description_: *** 7009,7015 **** The `SHORT' intrinsic is equivalent to `INT2'. _Standard_: ! GNU extension. _Class_: Elemental function --- 7572,7578 ---- The `SHORT' intrinsic is equivalent to `INT2'. _Standard_: ! GNU extension _Class_: Elemental function *************** _Syntax_: *** 7018,7025 **** `RESULT = INT2(A)' _Arguments_: ! A Shall be of type `INTEGER(*)', ! `REAL(*)', or `COMPLEX(*)'. _Return value_: The return value is a `INTEGER(2)' variable. --- 7581,7588 ---- `RESULT = INT2(A)' _Arguments_: ! A Shall be of type `INTEGER', `REAL', or ! `COMPLEX'. _Return value_: The return value is a `INTEGER(2)' variable. *************** _See also_: *** 7030,7036 ****  File: gfortran.info, Node: INT8, Next: IOR, Prev: INT2, Up: Intrinsic Procedures ! 6.111 `INT8' -- Convert to 64-bit integer type ============================================== _Description_: --- 7593,7599 ----  File: gfortran.info, Node: INT8, Next: IOR, Prev: INT2, Up: Intrinsic Procedures ! 7.114 `INT8' -- Convert to 64-bit integer type ============================================== _Description_: *************** _Description_: *** 7039,7045 **** and is only included for backwards compatibility. _Standard_: ! GNU extension. _Class_: Elemental function --- 7602,7608 ---- and is only included for backwards compatibility. _Standard_: ! GNU extension _Class_: Elemental function *************** _Syntax_: *** 7048,7055 **** `RESULT = INT8(A)' _Arguments_: ! A Shall be of type `INTEGER(*)', ! `REAL(*)', or `COMPLEX(*)'. _Return value_: The return value is a `INTEGER(8)' variable. --- 7611,7618 ---- `RESULT = INT8(A)' _Arguments_: ! A Shall be of type `INTEGER', `REAL', or ! `COMPLEX'. _Return value_: The return value is a `INTEGER(8)' variable. *************** _See also_: *** 7060,7073 ****  File: gfortran.info, Node: IOR, Next: IRAND, Prev: INT8, Up: Intrinsic Procedures ! 6.112 `IOR' -- Bitwise logical or ================================= _Description_: `IOR' returns the bitwise boolean inclusive-OR of I and J. _Standard_: ! F95 and later _Class_: Elemental function --- 7623,7636 ----  File: gfortran.info, Node: IOR, Next: IRAND, Prev: INT8, Up: Intrinsic Procedures ! 7.115 `IOR' -- Bitwise logical or ================================= _Description_: `IOR' returns the bitwise boolean inclusive-OR of I and J. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Syntax_: *** 7076,7090 **** `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.) _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.) _See also_: *note IEOR::, *note IAND::, *note IBITS::, *note IBSET::, *note --- 7639,7653 ---- `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.) _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.) _See also_: *note IEOR::, *note IAND::, *note IBITS::, *note IBSET::, *note *************** _See also_: *** 7093,7099 ****  File: gfortran.info, Node: IRAND, Next: IS_IOSTAT_END, Prev: IOR, Up: Intrinsic Procedures ! 6.113 `IRAND' -- Integer pseudo-random number ============================================= _Description_: --- 7656,7662 ----  File: gfortran.info, Node: IRAND, Next: IS_IOSTAT_END, Prev: IOR, Up: Intrinsic Procedures ! 7.116 `IRAND' -- Integer pseudo-random number ============================================= _Description_: *************** _Class_: *** 7116,7125 **** Function _Syntax_: ! `RESULT = IRAND(FLAG)' _Arguments_: ! FLAG Shall be a scalar `INTEGER' of kind 4. _Return value_: The return value is of `INTEGER(kind=4)' type. --- 7679,7688 ---- Function _Syntax_: ! `RESULT = IRAND(I)' _Arguments_: ! I Shall be a scalar `INTEGER' of kind 4. _Return value_: The return value is of `INTEGER(kind=4)' type. *************** _Example_: *** 7137,7143 ****  File: gfortran.info, Node: IS_IOSTAT_END, Next: IS_IOSTAT_EOR, Prev: IRAND, Up: Intrinsic Procedures ! 6.114 `IS_IOSTAT_END' -- Test for end-of-file value =================================================== _Description_: --- 7700,7706 ----  File: gfortran.info, Node: IS_IOSTAT_END, Next: IS_IOSTAT_EOR, Prev: IRAND, Up: Intrinsic Procedures ! 7.117 `IS_IOSTAT_END' -- Test for end-of-file value =================================================== _Description_: *************** _Description_: *** 7147,7153 **** `ISO_FORTRAN_ENV'. _Standard_: ! Fortran 2003. _Class_: Elemental function --- 7710,7716 ---- `ISO_FORTRAN_ENV'. _Standard_: ! Fortran 2003 and later _Class_: Elemental function *************** _Example_: *** 7175,7181 ****  File: gfortran.info, Node: IS_IOSTAT_EOR, Next: ISATTY, Prev: IS_IOSTAT_END, Up: Intrinsic Procedures ! 6.115 `IS_IOSTAT_EOR' -- Test for end-of-record value ===================================================== _Description_: --- 7738,7744 ----  File: gfortran.info, Node: IS_IOSTAT_EOR, Next: ISATTY, Prev: IS_IOSTAT_END, Up: Intrinsic Procedures ! 7.118 `IS_IOSTAT_EOR' -- Test for end-of-record value ===================================================== _Description_: *************** _Description_: *** 7185,7191 **** `ISO_FORTRAN_ENV'. _Standard_: ! Fortran 2003. _Class_: Elemental function --- 7748,7754 ---- `ISO_FORTRAN_ENV'. _Standard_: ! Fortran 2003 and later _Class_: Elemental function *************** _Example_: *** 7213,7226 ****  File: gfortran.info, Node: ISATTY, Next: ISHFT, Prev: IS_IOSTAT_EOR, Up: Intrinsic Procedures ! 6.116 `ISATTY' -- Whether a unit is a terminal device. ====================================================== _Description_: Determine whether a unit is connected to a terminal device. _Standard_: ! GNU extension. _Class_: Function --- 7776,7789 ----  File: gfortran.info, Node: ISATTY, Next: ISHFT, Prev: IS_IOSTAT_EOR, Up: Intrinsic Procedures ! 7.119 `ISATTY' -- Whether a unit is a terminal device. ====================================================== _Description_: Determine whether a unit is connected to a terminal device. _Standard_: ! GNU extension _Class_: Function *************** _Syntax_: *** 7229,7235 **** `RESULT = ISATTY(UNIT)' _Arguments_: ! UNIT Shall be a scalar `INTEGER(*)'. _Return value_: Returns `.TRUE.' if the UNIT is connected to a terminal device, --- 7792,7798 ---- `RESULT = ISATTY(UNIT)' _Arguments_: ! UNIT Shall be a scalar `INTEGER'. _Return value_: Returns `.TRUE.' if the UNIT is connected to a terminal device, *************** _See also_: *** 7249,7255 ****  File: gfortran.info, Node: ISHFT, Next: ISHFTC, Prev: ISATTY, Up: Intrinsic Procedures ! 6.117 `ISHFT' -- Shift bits =========================== _Description_: --- 7812,7818 ----  File: gfortran.info, Node: ISHFT, Next: ISHFTC, Prev: ISATTY, Up: Intrinsic Procedures ! 7.120 `ISHFT' -- Shift bits =========================== _Description_: *************** _Description_: *** 7262,7268 **** end are lost; zeros are shifted in from the opposite end. _Standard_: ! F95 and later _Class_: Elemental function --- 7825,7831 ---- end are lost; zeros are shifted in from the opposite end. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Syntax_: *** 7271,7281 **** `RESULT = ISHFT(I, SHIFT)' _Arguments_: ! 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. _See also_: *note ISHFTC:: --- 7834,7844 ---- `RESULT = ISHFT(I, SHIFT)' _Arguments_: ! 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. _See also_: *note ISHFTC:: *************** _See also_: *** 7283,7289 ****  File: gfortran.info, Node: ISHFTC, Next: ISNAN, Prev: ISHFT, Up: Intrinsic Procedures ! 6.118 `ISHFTC' -- Shift bits circularly ======================================= _Description_: --- 7846,7852 ----  File: gfortran.info, Node: ISHFTC, Next: ISNAN, Prev: ISHFT, Up: Intrinsic Procedures ! 7.121 `ISHFTC' -- Shift bits circularly ======================================= _Description_: *************** _Description_: *** 7297,7303 **** equivalent to `BIT_SIZE(I)'. _Standard_: ! F95 and later _Class_: Elemental function --- 7860,7866 ---- equivalent to `BIT_SIZE(I)'. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Syntax_: *** 7306,7319 **** `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)'. _Return value_: ! The return value is of type `INTEGER(*)' and of the same kind as I. _See also_: *note ISHFT:: --- 7869,7882 ---- `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)'. _Return value_: ! The return value is of type `INTEGER' and of the same kind as I. _See also_: *note ISHFT:: *************** _See also_: *** 7321,7327 ****  File: gfortran.info, Node: ISNAN, Next: ITIME, Prev: ISHFTC, Up: Intrinsic Procedures ! 6.119 `ISNAN' -- Test for a NaN =============================== _Description_: --- 7884,7890 ----  File: gfortran.info, Node: ISNAN, Next: ITIME, Prev: ISHFTC, Up: Intrinsic Procedures ! 7.122 `ISNAN' -- Test for a NaN =============================== _Description_: *************** _Example_: *** 7356,7369 ****  File: gfortran.info, Node: ITIME, Next: KILL, Prev: ISNAN, Up: Intrinsic Procedures ! 6.120 `ITIME' -- Get current local time subroutine (hour/minutes/seconds) ========================================================================= _Description_: ! `IDATE(TARRAY)' Fills TARRAY 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 TARRAY, respectively. _Standard_: GNU extension --- 7919,7932 ----  File: gfortran.info, Node: ITIME, Next: KILL, Prev: ISNAN, Up: Intrinsic Procedures ! 7.123 `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 range 1-60), and seconds (in the range 1-60) appear in elements 1, ! 2, and 3 of VALUES, respectively. _Standard_: GNU extension *************** _Class_: *** 7372,7385 **** Subroutine _Syntax_: ! `CALL ITIME(TARRAY)' _Arguments_: ! TARRAY The type shall be `INTEGER, DIMENSION(3)' and the kind shall be the default integer kind. _Return value_: ! Does not return. _Example_: program test_itime --- 7935,7948 ---- Subroutine _Syntax_: ! `CALL ITIME(VALUES)' _Arguments_: ! VALUES The type shall be `INTEGER, DIMENSION(3)' and the kind shall be the default integer kind. _Return value_: ! Does not return anything. _Example_: program test_itime *************** _Example_: *** 7393,7399 ****  File: gfortran.info, Node: KILL, Next: KIND, Prev: ITIME, Up: Intrinsic Procedures ! 6.121 `KILL' -- Send a signal to a process ========================================== _Description_: --- 7956,7962 ----  File: gfortran.info, Node: KILL, Next: KIND, Prev: ITIME, Up: Intrinsic Procedures ! 7.124 `KILL' -- Send a signal to a process ========================================== _Description_: *************** _Class_: *** 7409,7422 **** Subroutine, function _Syntax_: ! `CALL KILL(PID, SIGNAL [, STATUS])' _Arguments_: ! PID Shall be a scalar `INTEGER', with `INTENT(IN)' ! SIGNAL 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_: --- 7972,7984 ---- Subroutine, function _Syntax_: ! `CALL KILL(C, VALUE [, STATUS])' _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. _See also_: *************** _See also_: *** 7425,7438 ****  File: gfortran.info, Node: KIND, Next: LBOUND, Prev: KILL, Up: Intrinsic Procedures ! 6.122 `KIND' -- Kind of an entity ================================= _Description_: `KIND(X)' returns the kind value of the entity X. _Standard_: ! F95 and later _Class_: Inquiry function --- 7987,8000 ----  File: gfortran.info, Node: KIND, Next: LBOUND, Prev: KILL, Up: Intrinsic Procedures ! 7.125 `KIND' -- Kind of an entity ================================= _Description_: `KIND(X)' returns the kind value of the entity X. _Standard_: ! Fortran 95 and later _Class_: Inquiry function *************** _Example_: *** 7459,7467 ****  ! File: gfortran.info, Node: LBOUND, Next: LEN, Prev: KIND, Up: Intrinsic Procedures ! 6.123 `LBOUND' -- Lower dimension bounds of an array ==================================================== _Description_: --- 8021,8029 ----  ! File: gfortran.info, Node: LBOUND, Next: LEADZ, Prev: KIND, Up: Intrinsic Procedures ! 7.126 `LBOUND' -- Lower dimension bounds of an array ==================================================== _Description_: *************** _Description_: *** 7469,7475 **** along the DIM dimension. _Standard_: ! F95 and later _Class_: Inquiry function --- 8031,8037 ---- along the DIM dimension. _Standard_: ! Fortran 95 and later, with KIND argument Fortran 2003 and later _Class_: Inquiry function *************** _Syntax_: *** 7479,7488 **** _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. _Return value_: The return value is of type `INTEGER' and of kind KIND. If KIND is --- 8041,8050 ---- _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. _Return value_: The return value is of type `INTEGER' and of kind KIND. If KIND is *************** _See also_: *** 7498,7506 **** *note UBOUND::  ! File: gfortran.info, Node: LEN, Next: LEN_TRIM, Prev: LBOUND, Up: Intrinsic Procedures ! 6.124 `LEN' -- Length of a character entity =========================================== _Description_: --- 8060,8101 ---- *note UBOUND::  ! File: gfortran.info, Node: LEADZ, Next: LEN, Prev: LBOUND, Up: Intrinsic Procedures ! 7.127 `LEADZ' -- Number of leading zero bits of an integer ! ========================================================== ! ! _Description_: ! `LEADZ' returns the number of leading zero bits of an integer. ! ! _Standard_: ! Fortran 2008 and later ! ! _Class_: ! Elemental function ! ! _Syntax_: ! `RESULT = LEADZ(I)' ! ! _Arguments_: ! 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)'. ! ! _Example_: ! PROGRAM test_leadz ! WRITE (*,*) LEADZ(1) ! prints 8 if BITSIZE(I) has the value 32 ! END PROGRAM ! ! _See also_: ! *note BIT_SIZE::, *note TRAILZ:: ! !  ! File: gfortran.info, Node: LEN, Next: LEN_TRIM, Prev: LEADZ, Up: Intrinsic Procedures ! ! 7.128 `LEN' -- Length of a character entity =========================================== _Description_: *************** _Description_: *** 7510,7516 **** length, not the content, of STRING is needed. _Standard_: ! F77 and later _Class_: Inquiry function --- 8105,8111 ---- length, not the content, of STRING is needed. _Standard_: ! Fortran 77 and later, with KIND argument Fortran 2003 and later _Class_: Inquiry function *************** _Syntax_: *** 7520,7529 **** _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. _Return value_: The return value is of type `INTEGER' and of kind KIND. If KIND is --- 8115,8124 ---- _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. _Return value_: The return value is of type `INTEGER' and of kind KIND. If KIND is *************** _See also_: *** 7533,7541 **** *note LEN_TRIM::, *note ADJUSTL::, *note ADJUSTR::  ! File: gfortran.info, Node: LEN_TRIM, Next: LGAMMA, Prev: LEN, Up: Intrinsic Procedures ! 6.125 `LEN_TRIM' -- Length of a character entity without trailing blank characters ================================================================================== _Description_: --- 8128,8136 ---- *note LEN_TRIM::, *note ADJUSTL::, *note ADJUSTR::  ! File: gfortran.info, Node: LEN_TRIM, Next: LOG_GAMMA, Prev: LEN, Up: Intrinsic Procedures ! 7.129 `LEN_TRIM' -- Length of a character entity without trailing blank characters ================================================================================== _Description_: *************** _Description_: *** 7543,7549 **** blanks. _Standard_: ! F95 and later _Class_: Elemental function --- 8138,8144 ---- blanks. _Standard_: ! Fortran 95 and later, with KIND argument Fortran 2003 and later _Class_: Elemental function *************** _Syntax_: *** 7552,7562 **** `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. _Return value_: The return value is of type `INTEGER' and of kind KIND. If KIND is --- 8147,8157 ---- `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. _Return value_: The return value is of type `INTEGER' and of kind KIND. If KIND is *************** _See also_: *** 7566,7616 **** *note LEN::, *note ADJUSTL::, *note ADJUSTR::  ! File: gfortran.info, Node: LGAMMA, Next: LGE, Prev: LEN_TRIM, Up: Intrinsic Procedures ! ! 6.126 `LGAMMA' -- Logarithm of the Gamma function ! ================================================= ! ! _Description_: ! `GAMMA(X)' computes the natural logrithm of the absolute value of ! the Gamma (\Gamma) function. ! ! _Standard_: ! GNU Extension ! ! _Class_: ! Elemental function ! ! _Syntax_: ! `X = LGAMMA(X)' ! ! _Arguments_: ! 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. ! ! _Example_: ! program test_log_gamma ! real :: x = 1.0 ! x = lgamma(x) ! returns 0.0 ! 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 ! ! _See also_: ! Gamma function: *note GAMMA:: ! ! !  ! File: gfortran.info, Node: LGE, Next: LGT, Prev: LGAMMA, Up: Intrinsic Procedures ! 6.127 `LGE' -- Lexical greater than or equal ============================================ _Description_: --- 8161,8169 ---- *note LEN::, *note ADJUSTL::, *note ADJUSTR::  ! File: gfortran.info, Node: LGE, Next: LGT, Prev: LOG_GAMMA, Up: Intrinsic Procedures ! 7.130 `LGE' -- Lexical greater than or equal ============================================ _Description_: *************** _Description_: *** 7627,7633 **** targets), whereas the former always use the ASCII ordering. _Standard_: ! F77 and later _Class_: Elemental function --- 8180,8186 ---- targets), whereas the former always use the ASCII ordering. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _See also_: *** 7649,7655 ****  File: gfortran.info, Node: LGT, Next: LINK, Prev: LGE, Up: Intrinsic Procedures ! 6.128 `LGT' -- Lexical greater than =================================== _Description_: --- 8202,8208 ----  File: gfortran.info, Node: LGT, Next: LINK, Prev: LGE, Up: Intrinsic Procedures ! 7.131 `LGT' -- Lexical greater than =================================== _Description_: *************** _Description_: *** 7666,7672 **** targets), whereas the former always use the ASCII ordering. _Standard_: ! F77 and later _Class_: Elemental function --- 8219,8225 ---- targets), whereas the former always use the ASCII ordering. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _See also_: *** 7688,7694 ****  File: gfortran.info, Node: LINK, Next: LLE, Prev: LGT, Up: Intrinsic Procedures ! 6.129 `LINK' -- Create a hard link ================================== _Description_: --- 8241,8247 ----  File: gfortran.info, Node: LINK, Next: LLE, Prev: LGT, Up: Intrinsic Procedures ! 7.132 `LINK' -- Create a hard link ================================== _Description_: *************** _See also_: *** 7722,7728 ****  File: gfortran.info, Node: LLE, Next: LLT, Prev: LINK, Up: Intrinsic Procedures ! 6.130 `LLE' -- Lexical less than or equal ========================================= _Description_: --- 8275,8281 ----  File: gfortran.info, Node: LLE, Next: LLT, Prev: LINK, Up: Intrinsic Procedures ! 7.133 `LLE' -- Lexical less than or equal ========================================= _Description_: *************** _Description_: *** 7740,7746 **** targets), whereas the former always use the ASCII ordering. _Standard_: ! F77 and later _Class_: Elemental function --- 8293,8299 ---- targets), whereas the former always use the ASCII ordering. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _See also_: *** 7762,7768 ****  File: gfortran.info, Node: LLT, Next: LNBLNK, Prev: LLE, Up: Intrinsic Procedures ! 6.131 `LLT' -- Lexical less than ================================ _Description_: --- 8315,8321 ----  File: gfortran.info, Node: LLT, Next: LNBLNK, Prev: LLE, Up: Intrinsic Procedures ! 7.134 `LLT' -- Lexical less than ================================ _Description_: *************** _Description_: *** 7779,7785 **** targets), whereas the former always use the ASCII ordering. _Standard_: ! F77 and later _Class_: Elemental function --- 8332,8338 ---- targets), whereas the former always use the ASCII ordering. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _See also_: *** 7801,7807 ****  File: gfortran.info, Node: LNBLNK, Next: LOC, Prev: LLT, Up: Intrinsic Procedures ! 6.132 `LNBLNK' -- Index of the last non-blank character in a string =================================================================== _Description_: --- 8354,8360 ----  File: gfortran.info, Node: LNBLNK, Next: LOC, Prev: LLT, Up: Intrinsic Procedures ! 7.135 `LNBLNK' -- Index of the last non-blank character in a string =================================================================== _Description_: *************** _Syntax_: *** 7819,7825 **** `RESULT = LNBLNK(STRING)' _Arguments_: ! STRING Shall be a scalar of type `CHARACTER(*)', with `INTENT(IN)' _Return value_: --- 8372,8378 ---- `RESULT = LNBLNK(STRING)' _Arguments_: ! STRING Shall be a scalar of type `CHARACTER', with `INTENT(IN)' _Return value_: *************** _See also_: *** 7831,7837 ****  File: gfortran.info, Node: LOC, Next: LOG, Prev: LNBLNK, Up: Intrinsic Procedures ! 6.133 `LOC' -- Returns the address of a variable ================================================ _Description_: --- 8384,8390 ----  File: gfortran.info, Node: LOC, Next: LOG, Prev: LNBLNK, Up: Intrinsic Procedures ! 7.136 `LOC' -- Returns the address of a variable ================================================ _Description_: *************** _Example_: *** 7864,7877 ****  File: gfortran.info, Node: LOG, Next: LOG10, Prev: LOC, Up: Intrinsic Procedures ! 6.134 `LOG' -- Logarithm function ================================= _Description_: `LOG(X)' computes the logarithm of X. _Standard_: ! F77 and later _Class_: Elemental function --- 8417,8430 ----  File: gfortran.info, Node: LOG, Next: LOG10, Prev: LOC, Up: Intrinsic Procedures ! 7.137 `LOG' -- Logarithm function ================================= _Description_: `LOG(X)' computes the logarithm of X. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Syntax_: *** 7880,7890 **** `RESULT = LOG(X)' _Arguments_: ! 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. _Example_: program test_log --- 8433,8444 ---- `RESULT = LOG(X)' _Arguments_: ! 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 ! \omega is in the range -\pi \leq \omega \leq \pi. _Example_: program test_log *************** _Specific names_: *** 7908,7921 ****  File: gfortran.info, Node: LOG10, Next: LOGICAL, Prev: LOG, Up: Intrinsic Procedures ! 6.135 `LOG10' -- Base 10 logarithm function =========================================== _Description_: `LOG10(X)' computes the base 10 logarithm of X. _Standard_: ! F77 and later _Class_: Elemental function --- 8462,8475 ----  File: gfortran.info, Node: LOG10, Next: LOGICAL, Prev: LOG, Up: Intrinsic Procedures ! 7.138 `LOG10' -- Base 10 logarithm function =========================================== _Description_: `LOG10(X)' computes the base 10 logarithm of X. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Syntax_: *** 7924,7934 **** `RESULT = LOG10(X)' _Arguments_: ! X The type shall be `REAL(*)'. _Return value_: ! The return value is of type `REAL(*)' or `COMPLEX(*)'. The kind ! type parameter is the same as X. _Example_: program test_log10 --- 8478,8488 ---- `RESULT = LOG10(X)' _Arguments_: ! X The type shall be `REAL'. _Return value_: ! The return value is of type `REAL' or `COMPLEX'. The kind type ! parameter is the same as X. _Example_: program test_log10 *************** _Example_: *** 7938,7957 **** _Specific names_: Name Argument Return type Standard ! `ALOG10(X)' `REAL(4) X' `REAL(4)' F95 and later ! `DLOG10(X)' `REAL(8) X' `REAL(8)' F95 and later  File: gfortran.info, Node: LOGICAL, Next: LONG, Prev: LOG10, Up: Intrinsic Procedures ! 6.136 `LOGICAL' -- Convert to logical type ========================================== _Description_: Converts one kind of `LOGICAL' variable to another. _Standard_: ! F95 and later _Class_: Elemental function --- 8492,8555 ---- _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 ! !  ! File: gfortran.info, Node: LOG_GAMMA, Next: LGE, Prev: LEN_TRIM, Up: Intrinsic Procedures ! ! 7.139 `LOG_GAMMA' -- Logarithm of the Gamma function ! ==================================================== ! ! _Description_: ! `LOG_GAMMA(X)' computes the natural logarithm of the absolute value ! of the Gamma (\Gamma) function. ! ! _Standard_: ! Fortran 2008 and later ! ! _Class_: ! Elemental function ! ! _Syntax_: ! `X = LOG_GAMMA(X)' ! ! _Arguments_: ! 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. ! ! _Example_: ! program test_log_gamma ! real :: x = 1.0 ! x = lgamma(x) ! returns 0.0 ! 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 ! ! _See also_: ! Gamma function: *note GAMMA:: !  File: gfortran.info, Node: LOGICAL, Next: LONG, Prev: LOG10, Up: Intrinsic Procedures ! 7.140 `LOGICAL' -- Convert to logical type ========================================== _Description_: Converts one kind of `LOGICAL' variable to another. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Syntax_: *** 7960,7969 **** `RESULT = LOGICAL(L [, KIND])' _Arguments_: ! 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 --- 8558,8567 ---- `RESULT = LOGICAL(L [, KIND])' _Arguments_: ! 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 *************** _See also_: *** 7976,7982 ****  File: gfortran.info, Node: LONG, Next: LSHIFT, Prev: LOGICAL, Up: Intrinsic Procedures ! 6.137 `LONG' -- Convert to integer type ======================================= _Description_: --- 8574,8580 ----  File: gfortran.info, Node: LONG, Next: LSHIFT, Prev: LOGICAL, Up: Intrinsic Procedures ! 7.141 `LONG' -- Convert to integer type ======================================= _Description_: *************** _Description_: *** 7986,7992 **** included for backwards compatibility. _Standard_: ! GNU extension. _Class_: Elemental function --- 8584,8590 ---- included for backwards compatibility. _Standard_: ! GNU extension _Class_: Elemental function *************** _Syntax_: *** 7995,8002 **** `RESULT = LONG(A)' _Arguments_: ! A Shall be of type `INTEGER(*)', ! `REAL(*)', or `COMPLEX(*)'. _Return value_: The return value is a `INTEGER(4)' variable. --- 8593,8600 ---- `RESULT = LONG(A)' _Arguments_: ! A Shall be of type `INTEGER', `REAL', or ! `COMPLEX'. _Return value_: The return value is a `INTEGER(4)' variable. *************** _See also_: *** 8007,8013 ****  File: gfortran.info, Node: LSHIFT, Next: LSTAT, Prev: LONG, Up: Intrinsic Procedures ! 6.138 `LSHIFT' -- Left shift bits ================================= _Description_: --- 8605,8611 ----  File: gfortran.info, Node: LSHIFT, Next: LSTAT, Prev: LONG, Up: Intrinsic Procedures ! 7.142 `LSHIFT' -- Left shift bits ================================= _Description_: *************** _Syntax_: *** 8030,8040 **** `RESULT = LSHIFT(I, SHIFT)' _Arguments_: ! 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. _See also_: *note ISHFT::, *note ISHFTC::, *note RSHIFT:: --- 8628,8638 ---- `RESULT = LSHIFT(I, SHIFT)' _Arguments_: ! 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. _See also_: *note ISHFT::, *note ISHFTC::, *note RSHIFT:: *************** _See also_: *** 8043,8049 ****  File: gfortran.info, Node: LSTAT, Next: LTIME, Prev: LSHIFT, Up: Intrinsic Procedures ! 6.139 `LSTAT' -- Get file status ================================ _Description_: --- 8641,8647 ----  File: gfortran.info, Node: LSTAT, Next: LTIME, Prev: LSHIFT, Up: Intrinsic Procedures ! 7.143 `LSTAT' -- Get file status ================================ _Description_: *************** _Syntax_: *** 8066,8077 **** `CALL LSTAT(FILE, BUFF [, STATUS])' _Arguments_: ! FILE The type shall be `CHARACTER(*)', a valid path ! within the file system. BUFF 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. --- 8664,8675 ---- `CALL LSTAT(FILE, BUFF [, STATUS])' _Arguments_: ! FILE The type shall be `CHARACTER' of the default ! kind, a valid path within the file system. BUFF 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. *************** _See also_: *** 8082,8088 ****  File: gfortran.info, Node: LTIME, Next: MALLOC, Prev: LSTAT, Up: Intrinsic Procedures ! 6.140 `LTIME' -- Convert time to local time info ================================================ _Description_: --- 8680,8686 ----  File: gfortran.info, Node: LTIME, Next: MALLOC, Prev: LSTAT, Up: Intrinsic Procedures ! 7.144 `LTIME' -- Convert time to local time info ================================================ _Description_: *************** _Syntax_: *** 8100,8115 **** `CALL LTIME(STIME, TARRAY)' _Arguments_: ! STIME An `INTEGER(*)' scalar expression ! corresponding to a system time, with ! `INTENT(IN)'. TARRAY A default `INTEGER' array with 9 elements, ! with `INTENT(OUT)'. _Return value_: The elements of TARRAY 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 --- 8698,8712 ---- `CALL LTIME(STIME, TARRAY)' _Arguments_: ! STIME An `INTEGER' scalar expression corresponding ! to a system time, with `INTENT(IN)'. TARRAY A default `INTEGER' array with 9 elements, ! with `INTENT(OUT)'. _Return value_: The elements of TARRAY 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 *************** _Return value_: *** 8126,8133 **** 8. Days since January 1 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:: --- 8723,8730 ---- 8. Days since January 1 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:: *************** _See also_: *** 8136,8142 ****  File: gfortran.info, Node: MALLOC, Next: MATMUL, Prev: LTIME, Up: Intrinsic Procedures ! 6.141 `MALLOC' -- Allocate dynamic memory ========================================= _Description_: --- 8733,8739 ----  File: gfortran.info, Node: MALLOC, Next: MATMUL, Prev: LTIME, Up: Intrinsic Procedures ! 7.145 `MALLOC' -- Allocate dynamic memory ========================================= _Description_: *************** _Syntax_: *** 8157,8163 **** `PTR = MALLOC(SIZE)' _Arguments_: ! SIZE The type shall be `INTEGER(*)'. _Return value_: The return value is of type `INTEGER(K)', with K such that --- 8754,8760 ---- `PTR = MALLOC(SIZE)' _Arguments_: ! SIZE The type shall be `INTEGER'. _Return value_: The return value is of type `INTEGER(K)', with K such that *************** _Return value_: *** 8166,8179 **** _Example_: The following example demonstrates the use of `MALLOC' and `FREE' ! with Cray pointers. This example is intended to run on 32-bit ! systems, where the default integer kind is suitable to store ! pointers; on 64-bit systems, ptr_x would need to be declared as ! `integer(kind=8)'. program test_malloc integer i - integer ptr_x real*8 x(*), z pointer(ptr_x,x) --- 8763,8773 ---- _Example_: The following example demonstrates the use of `MALLOC' and `FREE' ! with Cray pointers. program test_malloc + implicit none integer i real*8 x(*), z pointer(ptr_x,x) *************** _See also_: *** 8195,8208 ****  File: gfortran.info, Node: MATMUL, Next: MAX, Prev: MALLOC, Up: Intrinsic Procedures ! 6.142 `MATMUL' -- matrix multiplication ======================================= _Description_: Performs a matrix multiplication on numeric or logical arguments. _Standard_: ! F95 and later _Class_: Transformational function --- 8789,8802 ----  File: gfortran.info, Node: MATMUL, Next: MAX, Prev: MALLOC, Up: Intrinsic Procedures ! 7.146 `MATMUL' -- matrix multiplication ======================================= _Description_: Performs a matrix multiplication on numeric or logical arguments. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _Syntax_: *** 8211,8228 **** `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. _Return value_: The matrix product of MATRIX_A and MATRIX_B. The type and kind of --- 8805,8818 ---- `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. _Return value_: The matrix product of MATRIX_A and MATRIX_B. The type and kind of *************** _See also_: *** 8234,8247 ****  File: gfortran.info, Node: MAX, Next: MAXEXPONENT, Prev: MATMUL, Up: Intrinsic Procedures ! 6.143 `MAX' -- Maximum value of an argument list ================================================ _Description_: Returns the argument with the largest (most positive) value. _Standard_: ! F77 and later _Class_: Elemental function --- 8824,8837 ----  File: gfortran.info, Node: MAX, Next: MAXEXPONENT, Prev: MATMUL, Up: Intrinsic Procedures ! 7.147 `MAX' -- Maximum value of an argument list ================================================ _Description_: Returns the argument with the largest (most positive) value. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Syntax_: *** 8250,8262 **** `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.) _Return value_: The return value corresponds to the maximum value among the --- 8840,8849 ---- `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.) _Return value_: The return value corresponds to the maximum value among the *************** _Return value_: *** 8264,8278 **** _Specific names_: Name Argument Return type Standard ! `MAX0(I)' `INTEGER(4) `INTEGER(4)' F77 and later ! I' ! `AMAX0(I)' `INTEGER(4) `REAL(MAX(X))'F77 and later ! I' ! `MAX1(X)' `REAL(*) X' `INT(MAX(X))' F77 and later ! `AMAX1(X)' `REAL(4) `REAL(4)' F77 and later ! X' ! `DMAX1(X)' `REAL(8) `REAL(8)' F77 and later ! X' _See also_: *note MAXLOC:: *note MAXVAL::, *note MIN:: --- 8851,8866 ---- _Specific names_: Name Argument Return type Standard ! `MAX0(I)' `INTEGER(4) `INTEGER(4)' Fortran 77 and ! I' later ! `AMAX0(I)' `INTEGER(4) `REAL(MAX(X))'Fortran 77 and ! I' later ! `MAX1(X)' `REAL X' `INT(MAX(X))' Fortran 77 and ! later ! `AMAX1(X)' `REAL(4) `REAL(4)' Fortran 77 and ! X' later ! `DMAX1(X)' `REAL(8) `REAL(8)' Fortran 77 and ! X' later _See also_: *note MAXLOC:: *note MAXVAL::, *note MIN:: *************** _See also_: *** 8281,8287 ****  File: gfortran.info, Node: MAXEXPONENT, Next: MAXLOC, Prev: MAX, Up: Intrinsic Procedures ! 6.144 `MAXEXPONENT' -- Maximum exponent of a real kind ====================================================== _Description_: --- 8869,8875 ----  File: gfortran.info, Node: MAXEXPONENT, Next: MAXLOC, Prev: MAX, Up: Intrinsic Procedures ! 7.148 `MAXEXPONENT' -- Maximum exponent of a real kind ====================================================== _Description_: *************** _Description_: *** 8289,8295 **** type of `X'. _Standard_: ! F95 and later _Class_: Inquiry function --- 8877,8883 ---- type of `X'. _Standard_: ! Fortran 95 and later _Class_: Inquiry function *************** _Example_: *** 8316,8322 ****  File: gfortran.info, Node: MAXLOC, Next: MAXVAL, Prev: MAXEXPONENT, Up: Intrinsic Procedures ! 6.145 `MAXLOC' -- Location of the maximum value within an array =============================================================== _Description_: --- 8904,8910 ----  File: gfortran.info, Node: MAXLOC, Next: MAXVAL, Prev: MAXEXPONENT, Up: Intrinsic Procedures ! 7.149 `MAXLOC' -- Location of the maximum value within an array =============================================================== _Description_: *************** _Description_: *** 8333,8339 **** value for that row is zero. _Standard_: ! F95 and later _Class_: Transformational function --- 8921,8927 ---- value for that row is zero. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _Syntax_: *** 8343,8357 **** `RESULT = MAXLOC(ARRAY [, MASK])' _Arguments_: ! ARRAY Shall be an array of type `INTEGER(*)', ! `REAL(*)', or `CHARACTER(*)'. 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 --- 8931,8944 ---- `RESULT = MAXLOC(ARRAY [, MASK])' _Arguments_: ! ARRAY Shall be an array of type `INTEGER', `REAL', ! or `CHARACTER'. 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 *************** _See also_: *** 8368,8374 ****  File: gfortran.info, Node: MAXVAL, Next: MCLOCK, Prev: MAXLOC, Up: Intrinsic Procedures ! 6.146 `MAXVAL' -- Maximum value of an array =========================================== _Description_: --- 8955,8961 ----  File: gfortran.info, Node: MAXVAL, Next: MCLOCK, Prev: MAXLOC, Up: Intrinsic Procedures ! 7.150 `MAXVAL' -- Maximum value of an array =========================================== _Description_: *************** _Description_: *** 8377,8388 **** 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 the most negative number of ! the type and kind of ARRAY if ARRAY is numeric, or a string of ! nulls if ARRAY is of character type. _Standard_: ! F95 and later _Class_: Transformational function --- 8964,8974 ---- 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 _Class_: Transformational function *************** _Syntax_: *** 8392,8406 **** `RESULT = MAXVAL(ARRAY [, MASK])' _Arguments_: ! ARRAY Shall be an array of type `INTEGER(*)', ! `REAL(*)', or `CHARACTER(*)'. 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 --- 8978,8991 ---- `RESULT = MAXVAL(ARRAY [, MASK])' _Arguments_: ! ARRAY Shall be an array of type `INTEGER', `REAL', ! or `CHARACTER'. 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 *************** _See also_: *** 8415,8421 ****  File: gfortran.info, Node: MCLOCK, Next: MCLOCK8, Prev: MAXVAL, Up: Intrinsic Procedures ! 6.147 `MCLOCK' -- Time function =============================== _Description_: --- 9000,9006 ----  File: gfortran.info, Node: MCLOCK, Next: MCLOCK8, Prev: MAXVAL, Up: Intrinsic Procedures ! 7.151 `MCLOCK' -- Time function =============================== _Description_: *************** _See also_: *** 8450,8456 ****  File: gfortran.info, Node: MCLOCK8, Next: MERGE, Prev: MCLOCK, Up: Intrinsic Procedures ! 6.148 `MCLOCK8' -- Time function (64-bit) ========================================= _Description_: --- 9035,9041 ----  File: gfortran.info, Node: MCLOCK8, Next: MERGE, Prev: MCLOCK, Up: Intrinsic Procedures ! 7.152 `MCLOCK8' -- Time function (64-bit) ========================================= _Description_: *************** _See also_: *** 8488,8494 ****  File: gfortran.info, Node: MERGE, Next: MIN, Prev: MCLOCK8, Up: Intrinsic Procedures ! 6.149 `MERGE' -- Merge variables ================================ _Description_: --- 9073,9079 ----  File: gfortran.info, Node: MERGE, Next: MIN, Prev: MCLOCK8, Up: Intrinsic Procedures ! 7.153 `MERGE' -- Merge variables ================================ _Description_: *************** _Description_: *** 8497,8503 **** FSOURCE if it is `.FALSE.'. _Standard_: ! F95 and later _Class_: Elemental function --- 9082,9088 ---- FSOURCE if it is `.FALSE.'. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Syntax_: *** 8508,8515 **** _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(*)'. _Return value_: The result is of the same type and type parameters as TSOURCE. --- 9093,9100 ---- _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'. _Return value_: The result is of the same type and type parameters as TSOURCE. *************** _Return value_: *** 8518,8531 ****  File: gfortran.info, Node: MIN, Next: MINEXPONENT, Prev: MERGE, Up: Intrinsic Procedures ! 6.150 `MIN' -- Minimum value of an argument list ================================================ _Description_: Returns the argument with the smallest (most negative) value. _Standard_: ! F77 and later _Class_: Elemental function --- 9103,9116 ----  File: gfortran.info, Node: MIN, Next: MINEXPONENT, Prev: MERGE, Up: Intrinsic Procedures ! 7.154 `MIN' -- Minimum value of an argument list ================================================ _Description_: Returns the argument with the smallest (most negative) value. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Syntax_: *** 8534,8546 **** `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.) _Return value_: The return value corresponds to the maximum value among the --- 9119,9128 ---- `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.) _Return value_: The return value corresponds to the maximum value among the *************** _Return value_: *** 8548,8562 **** _Specific names_: Name Argument Return type Standard ! `MIN0(I)' `INTEGER(4) `INTEGER(4)' F77 and later ! I' ! `AMIN0(I)' `INTEGER(4) `REAL(MIN(X))'F77 and later ! I' ! `MIN1(X)' `REAL(*) X' `INT(MIN(X))' F77 and later ! `AMIN1(X)' `REAL(4) `REAL(4)' F77 and later ! X' ! `DMIN1(X)' `REAL(8) `REAL(8)' F77 and later ! X' _See also_: *note MAX::, *note MINLOC::, *note MINVAL:: --- 9130,9145 ---- _Specific names_: Name Argument Return type Standard ! `MIN0(I)' `INTEGER(4) `INTEGER(4)' Fortran 77 and ! I' later ! `AMIN0(I)' `INTEGER(4) `REAL(MIN(X))'Fortran 77 and ! I' later ! `MIN1(X)' `REAL X' `INT(MIN(X))' Fortran 77 and ! later ! `AMIN1(X)' `REAL(4) `REAL(4)' Fortran 77 and ! X' later ! `DMIN1(X)' `REAL(8) `REAL(8)' Fortran 77 and ! X' later _See also_: *note MAX::, *note MINLOC::, *note MINVAL:: *************** _See also_: *** 8564,8570 ****  File: gfortran.info, Node: MINEXPONENT, Next: MINLOC, Prev: MIN, Up: Intrinsic Procedures ! 6.151 `MINEXPONENT' -- Minimum exponent of a real kind ====================================================== _Description_: --- 9147,9153 ----  File: gfortran.info, Node: MINEXPONENT, Next: MINLOC, Prev: MIN, Up: Intrinsic Procedures ! 7.155 `MINEXPONENT' -- Minimum exponent of a real kind ====================================================== _Description_: *************** _Description_: *** 8572,8578 **** type of `X'. _Standard_: ! F95 and later _Class_: Inquiry function --- 9155,9161 ---- type of `X'. _Standard_: ! Fortran 95 and later _Class_: Inquiry function *************** _Example_: *** 8593,8599 ****  File: gfortran.info, Node: MINLOC, Next: MINVAL, Prev: MINEXPONENT, Up: Intrinsic Procedures ! 6.152 `MINLOC' -- Location of the minimum value within an array =============================================================== _Description_: --- 9176,9182 ----  File: gfortran.info, Node: MINLOC, Next: MINVAL, Prev: MINEXPONENT, Up: Intrinsic Procedures ! 7.156 `MINLOC' -- Location of the minimum value within an array =============================================================== _Description_: *************** _Description_: *** 8610,8616 **** value for that row is zero. _Standard_: ! F95 and later _Class_: Transformational function --- 9193,9199 ---- value for that row is zero. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _Syntax_: *** 8620,8634 **** `RESULT = MINLOC(ARRAY [, MASK])' _Arguments_: ! ARRAY Shall be an array of type `INTEGER(*)', ! `REAL(*)', or `CHARACTER(*)'. 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 --- 9203,9216 ---- `RESULT = MINLOC(ARRAY [, MASK])' _Arguments_: ! ARRAY Shall be an array of type `INTEGER', `REAL', ! or `CHARACTER'. 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 *************** _See also_: *** 8645,8651 ****  File: gfortran.info, Node: MINVAL, Next: MOD, Prev: MINLOC, Up: Intrinsic Procedures ! 6.153 `MINVAL' -- Minimum value of an array =========================================== _Description_: --- 9227,9233 ----  File: gfortran.info, Node: MINVAL, Next: MOD, Prev: MINLOC, Up: Intrinsic Procedures ! 7.157 `MINVAL' -- Minimum value of an array =========================================== _Description_: *************** _Description_: *** 8659,8665 **** character type. _Standard_: ! F95 and later _Class_: Transformational function --- 9241,9247 ---- character type. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _Syntax_: *** 8669,8683 **** `RESULT = MINVAL(ARRAY [, MASK])' _Arguments_: ! ARRAY Shall be an array of type `INTEGER(*)', ! `REAL(*)', or `CHARACTER(*)'. 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 --- 9251,9264 ---- `RESULT = MINVAL(ARRAY [, MASK])' _Arguments_: ! ARRAY Shall be an array of type `INTEGER', `REAL', ! or `CHARACTER'. 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 *************** _See also_: *** 8693,8699 ****  File: gfortran.info, Node: MOD, Next: MODULO, Prev: MINVAL, Up: Intrinsic Procedures ! 6.154 `MOD' -- Remainder function ================================= _Description_: --- 9274,9280 ----  File: gfortran.info, Node: MOD, Next: MODULO, Prev: MINVAL, Up: Intrinsic Procedures ! 7.158 `MOD' -- Remainder function ================================= _Description_: *************** _Description_: *** 8701,8707 **** calculated as `A - (INT(A/P) * P)'. _Standard_: ! F77 and later _Class_: Elemental function --- 9282,9288 ---- calculated as `A - (INT(A/P) * P)'. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Example_: *** 8738,8757 **** _Specific names_: Name Arguments Return type Standard ! `AMOD(A,P)' `REAL(4)' `REAL(4)' F95 and later ! `DMOD(A,P)' `REAL(8)' `REAL(8)' F95 and later  File: gfortran.info, Node: MODULO, Next: MOVE_ALLOC, Prev: MOD, Up: Intrinsic Procedures ! 6.155 `MODULO' -- Modulo function ================================= _Description_: `MODULO(A,P)' computes the A modulo P. _Standard_: ! F95 and later _Class_: Elemental function --- 9319,9340 ---- _Specific names_: Name Arguments Return type Standard ! `AMOD(A,P)' `REAL(4)' `REAL(4)' Fortran 95 and ! later ! `DMOD(A,P)' `REAL(8)' `REAL(8)' Fortran 95 and ! later  File: gfortran.info, Node: MODULO, Next: MOVE_ALLOC, Prev: MOD, Up: Intrinsic Procedures ! 7.159 `MODULO' -- Modulo function ================================= _Description_: `MODULO(A,P)' computes the A modulo P. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Example_: *** 8790,8796 ****  File: gfortran.info, Node: MOVE_ALLOC, Next: MVBITS, Prev: MODULO, Up: Intrinsic Procedures ! 6.156 `MOVE_ALLOC' -- Move allocation from one object to another ================================================================ _Description_: --- 9373,9379 ----  File: gfortran.info, Node: MOVE_ALLOC, Next: MVBITS, Prev: MODULO, Up: Intrinsic Procedures ! 7.160 `MOVE_ALLOC' -- Move allocation from one object to another ================================================================ _Description_: *************** _Description_: *** 8798,8804 **** SRC will become deallocated in the process. _Standard_: ! F2003 and later _Class_: Subroutine --- 9381,9387 ---- SRC will become deallocated in the process. _Standard_: ! Fortran 2003 and later _Class_: Subroutine *************** _Syntax_: *** 8807,8817 **** `CALL MOVE_ALLOC(SRC, DEST)' _Arguments_: ! SRC `ALLOCATABLE', `INTENT(INOUT)', may be ! of any type and kind. ! DEST `ALLOCATABLE', `INTENT(OUT)', shall be ! of the same type, kind and rank ! as SRC _Return value_: None --- 9390,9399 ---- `CALL MOVE_ALLOC(SRC, DEST)' _Arguments_: ! SRC `ALLOCATABLE', `INTENT(INOUT)', may be of any ! type and kind. ! DEST `ALLOCATABLE', `INTENT(OUT)', shall be of the ! same type, kind and rank as SRC. _Return value_: None *************** _Example_: *** 8830,8836 ****  File: gfortran.info, Node: MVBITS, Next: NEAREST, Prev: MOVE_ALLOC, Up: Intrinsic Procedures ! 6.157 `MVBITS' -- Move bits from one integer to another ======================================================= _Description_: --- 9412,9418 ----  File: gfortran.info, Node: MVBITS, Next: NEAREST, Prev: MOVE_ALLOC, Up: Intrinsic Procedures ! 7.161 `MVBITS' -- Move bits from one integer to another ======================================================= _Description_: *************** _Description_: *** 8841,8847 **** `BIT_SIZE(FROM)'. _Standard_: ! F95 and later _Class_: Elemental subroutine --- 9423,9429 ---- `BIT_SIZE(FROM)'. _Standard_: ! Fortran 95 and later _Class_: Elemental subroutine *************** _Syntax_: *** 8850,8861 **** `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(*)'. _See also_: *note IBCLR::, *note IBSET::, *note IBITS::, *note IAND::, *note --- 9432,9443 ---- `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'. _See also_: *note IBCLR::, *note IBSET::, *note IBITS::, *note IAND::, *note *************** _See also_: *** 8864,8870 ****  File: gfortran.info, Node: NEAREST, Next: NEW_LINE, Prev: MVBITS, Up: Intrinsic Procedures ! 6.158 `NEAREST' -- Nearest representable number =============================================== _Description_: --- 9446,9452 ----  File: gfortran.info, Node: NEAREST, Next: NEW_LINE, Prev: MVBITS, Up: Intrinsic Procedures ! 7.162 `NEAREST' -- Nearest representable number =============================================== _Description_: *************** _Description_: *** 8872,8878 **** to `X' in the direction indicated by the sign of `S'. _Standard_: ! F95 and later _Class_: Elemental function --- 9454,9460 ---- to `X' in the direction indicated by the sign of `S'. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Example_: *** 8902,8915 ****  File: gfortran.info, Node: NEW_LINE, Next: NINT, Prev: NEAREST, Up: Intrinsic Procedures ! 6.159 `NEW_LINE' -- New line character ====================================== _Description_: `NEW_LINE(C)' returns the new-line character. _Standard_: ! F2003 and later _Class_: Inquiry function --- 9484,9497 ----  File: gfortran.info, Node: NEW_LINE, Next: NINT, Prev: NEAREST, Up: Intrinsic Procedures ! 7.163 `NEW_LINE' -- New line character ====================================== _Description_: `NEW_LINE(C)' returns the new-line character. _Standard_: ! Fortran 2003 and later _Class_: Inquiry function *************** _Syntax_: *** 8919,8925 **** _Arguments_: 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 --- 9501,9507 ---- _Arguments_: 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 *************** _Example_: *** 8934,8956 ****  File: gfortran.info, Node: NINT, Next: NOT, Prev: NEW_LINE, Up: Intrinsic Procedures ! 6.160 `NINT' -- Nearest whole number ==================================== _Description_: `NINT(X)' rounds its argument to the nearest whole number. _Standard_: ! F77 and later _Class_: Elemental function _Syntax_: ! `RESULT = NINT(X)' _Arguments_: X The type of the argument shall be `REAL'. _Return value_: Returns A with the fractional portion of its magnitude eliminated --- 9516,9541 ----  File: gfortran.info, Node: NINT, Next: NOT, Prev: NEW_LINE, Up: Intrinsic Procedures ! 7.164 `NINT' -- Nearest whole number ==================================== _Description_: `NINT(X)' rounds its argument to the nearest whole number. _Standard_: ! Fortran 77 and later, with KIND argument Fortran 90 and later _Class_: Elemental function _Syntax_: ! `RESULT = NINT(X [, KIND])' _Arguments_: X 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 *************** _Example_: *** 8968,8974 **** _Specific names_: Name Argument Standard ! `IDNINT(X)' `REAL(8)' F95 and later _See also_: *note CEILING::, *note FLOOR:: --- 9553,9560 ---- _Specific names_: Name Argument Standard ! `IDNINT(X)' `REAL(8)' Fortran 95 and ! later _See also_: *note CEILING::, *note FLOOR:: *************** _See also_: *** 8977,8990 ****  File: gfortran.info, Node: NOT, Next: NULL, Prev: NINT, Up: Intrinsic Procedures ! 6.161 `NOT' -- Logical negation =============================== _Description_: `NOT' returns the bitwise boolean inverse of I. _Standard_: ! F95 and later _Class_: Elemental function --- 9563,9576 ----  File: gfortran.info, Node: NOT, Next: NULL, Prev: NINT, Up: Intrinsic Procedures ! 7.165 `NOT' -- Logical negation =============================== _Description_: `NOT' returns the bitwise boolean inverse of I. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Syntax_: *** 8993,9002 **** `RESULT = NOT(I)' _Arguments_: ! I The type shall be `INTEGER(*)'. _Return value_: ! The return type is `INTEGER(*)', of the same kind as the argument. _See also_: *note IAND::, *note IEOR::, *note IOR::, *note IBITS::, *note --- 9579,9588 ---- `RESULT = NOT(I)' _Arguments_: ! I The type shall be `INTEGER'. _Return value_: ! The return type is `INTEGER', of the same kind as the argument. _See also_: *note IAND::, *note IEOR::, *note IOR::, *note IBITS::, *note *************** _See also_: *** 9006,9012 ****  File: gfortran.info, Node: NULL, Next: OR, Prev: NOT, Up: Intrinsic Procedures ! 6.162 `NULL' -- Function that returns an disassociated pointer ============================================================== _Description_: --- 9592,9598 ----  File: gfortran.info, Node: NULL, Next: OR, Prev: NOT, Up: Intrinsic Procedures ! 7.166 `NULL' -- Function that returns an disassociated pointer ============================================================== _Description_: *************** _Description_: *** 9015,9025 **** If MOLD is present, a dissassociated pointer of the same type is returned, otherwise the type is determined by context. ! In Fortran 95, MOLD is optional. Please note that F2003 includes ! cases where it is required. _Standard_: ! F95 and later _Class_: Transformational function --- 9601,9611 ---- If MOLD is present, a dissassociated 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 ! includes cases where it is required. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _See also_: *** 9043,9049 ****  File: gfortran.info, Node: OR, Next: PACK, Prev: NULL, Up: Intrinsic Procedures ! 6.163 `OR' -- Bitwise logical OR ================================ _Description_: --- 9629,9635 ----  File: gfortran.info, Node: OR, Next: PACK, Prev: NULL, Up: Intrinsic Procedures ! 7.167 `OR' -- Bitwise logical OR ================================ _Description_: *************** _Syntax_: *** 9064,9077 **** `RESULT = OR(X, Y)' _Arguments_: ! X The type shall be either `INTEGER(*)' or ! `LOGICAL'. ! Y The type shall be either `INTEGER(*)' or ! `LOGICAL'. _Return value_: ! The return type is either `INTEGER(*)' or `LOGICAL' after ! cross-promotion of the arguments. _Example_: PROGRAM test_or --- 9650,9664 ---- `RESULT = OR(X, Y)' _Arguments_: ! X The type shall be either a scalar `INTEGER' ! type or a scalar `LOGICAL' type. ! Y The type shall be the same as the type of X. _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. _Example_: PROGRAM test_or *************** _Example_: *** 9084,9095 **** END PROGRAM _See also_: ! F95 elemental function: *note IOR::  File: gfortran.info, Node: PACK, Next: PERROR, Prev: OR, Up: Intrinsic Procedures ! 6.164 `PACK' -- Pack an array into an array of rank one ======================================================= _Description_: --- 9671,9682 ---- END PROGRAM _See also_: ! Fortran 95 elemental function: *note IOR::  File: gfortran.info, Node: PACK, Next: PERROR, Prev: OR, Up: Intrinsic Procedures ! 7.168 `PACK' -- Pack an array into an array of rank one ======================================================= _Description_: *************** _Description_: *** 9100,9106 **** taken from VECTOR. _Standard_: ! F95 and later _Class_: Transformational function --- 9687,9693 ---- taken from VECTOR. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _See also_: *** 9148,9154 ****  File: gfortran.info, Node: PERROR, Next: PRECISION, Prev: PACK, Up: Intrinsic Procedures ! 6.165 `PERROR' -- Print system error message ============================================ _Description_: --- 9735,9741 ----  File: gfortran.info, Node: PERROR, Next: PRECISION, Prev: PACK, Up: Intrinsic Procedures ! 7.169 `PERROR' -- Print system error message ============================================ _Description_: *************** _Syntax_: *** 9166,9172 **** `CALL PERROR(STRING)' _Arguments_: ! STRING A scalar of default `CHARACTER' type. _See also_: *note IERRNO:: --- 9753,9760 ---- `CALL PERROR(STRING)' _Arguments_: ! STRING A scalar of type `CHARACTER' and of the ! default kind. _See also_: *note IERRNO:: *************** _See also_: *** 9174,9180 ****  File: gfortran.info, Node: PRECISION, Next: PRESENT, Prev: PERROR, Up: Intrinsic Procedures ! 6.166 `PRECISION' -- Decimal precision of a real kind ===================================================== _Description_: --- 9762,9768 ----  File: gfortran.info, Node: PRECISION, Next: PRESENT, Prev: PERROR, Up: Intrinsic Procedures ! 7.170 `PRECISION' -- Decimal precision of a real kind ===================================================== _Description_: *************** _Description_: *** 9182,9188 **** type of `X'. _Standard_: ! F95 and later _Class_: Inquiry function --- 9770,9776 ---- type of `X'. _Standard_: ! Fortran 95 and later _Class_: Inquiry function *************** _Example_: *** 9209,9222 ****  File: gfortran.info, Node: PRESENT, Next: PRODUCT, Prev: PRECISION, Up: Intrinsic Procedures ! 6.167 `PRESENT' -- Determine whether an optional dummy argument is specified ============================================================================ _Description_: Determines whether an optional dummy argument is present. _Standard_: ! F95 and later _Class_: Inquiry function --- 9797,9810 ----  File: gfortran.info, Node: PRESENT, Next: PRODUCT, Prev: PRECISION, Up: Intrinsic Procedures ! 7.171 `PRESENT' -- Determine whether an optional dummy argument is specified ============================================================================ _Description_: Determines whether an optional dummy argument is present. _Standard_: ! Fortran 95 and later _Class_: Inquiry function *************** _Example_: *** 9248,9254 ****  File: gfortran.info, Node: PRODUCT, Next: RADIX, Prev: PRESENT, Up: Intrinsic Procedures ! 6.168 `PRODUCT' -- Product of array elements ============================================ _Description_: --- 9836,9842 ----  File: gfortran.info, Node: PRODUCT, Next: RADIX, Prev: PRESENT, Up: Intrinsic Procedures ! 7.172 `PRODUCT' -- Product of array elements ============================================ _Description_: *************** _Description_: *** 9256,9262 **** corresponding element in MASK is `TRUE'. _Standard_: ! F95 and later _Class_: Transformational function --- 9844,9850 ---- corresponding element in MASK is `TRUE'. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _Syntax_: *** 9266,9273 **** 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. --- 9854,9861 ---- 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. *************** _See also_: *** 9296,9309 ****  File: gfortran.info, Node: RADIX, Next: RANDOM_NUMBER, Prev: PRODUCT, Up: Intrinsic Procedures ! 6.169 `RADIX' -- Base of a model number ======================================= _Description_: `RADIX(X)' returns the base of the model representing the entity X. _Standard_: ! F95 and later _Class_: Inquiry function --- 9884,9897 ----  File: gfortran.info, Node: RADIX, Next: RANDOM_NUMBER, Prev: PRODUCT, Up: Intrinsic Procedures ! 7.173 `RADIX' -- Base of a model number ======================================= _Description_: `RADIX(X)' returns the base of the model representing the entity X. _Standard_: ! Fortran 95 and later _Class_: Inquiry function *************** _Example_: *** 9328,9334 ****  File: gfortran.info, Node: RAN, Next: REAL, Prev: RANGE, Up: Intrinsic Procedures ! 6.170 `RAN' -- Real pseudo-random number ======================================== _Description_: --- 9916,9922 ----  File: gfortran.info, Node: RAN, Next: REAL, Prev: RANGE, Up: Intrinsic Procedures ! 7.174 `RAN' -- Real pseudo-random number ======================================== _Description_: *************** _See also_: *** 9348,9354 ****  File: gfortran.info, Node: RAND, Next: RANGE, Prev: RANDOM_SEED, Up: Intrinsic Procedures ! 6.171 `RAND' -- Real pseudo-random number ========================================= _Description_: --- 9936,9942 ----  File: gfortran.info, Node: RAND, Next: RANGE, Prev: RANDOM_SEED, Up: Intrinsic Procedures ! 7.175 `RAND' -- Real pseudo-random number ========================================= _Description_: *************** _See also_: *** 9394,9400 ****  File: gfortran.info, Node: RANDOM_NUMBER, Next: RANDOM_SEED, Prev: RADIX, Up: Intrinsic Procedures ! 6.172 `RANDOM_NUMBER' -- Pseudo-random number ============================================= _Description_: --- 9982,9988 ----  File: gfortran.info, Node: RANDOM_NUMBER, Next: RANDOM_SEED, Prev: RADIX, Up: Intrinsic Procedures ! 7.176 `RANDOM_NUMBER' -- Pseudo-random number ============================================= _Description_: *************** _Description_: *** 9413,9419 **** 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 --- 10001,10007 ---- 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 *************** _Description_: *** 9421,9427 **** dedicated parallel random number generator instead. _Standard_: ! F95 and later _Class_: Subroutine --- 10009,10015 ---- dedicated parallel random number generator instead. _Standard_: ! Fortran 95 and later _Class_: Subroutine *************** _Syntax_: *** 9430,9437 **** `RANDOM_NUMBER(HARVEST)' _Arguments_: ! HARVEST Shall be a scalar or an array of type ! `REAL(*)'. _Example_: program test_random_number --- 10018,10024 ---- `RANDOM_NUMBER(HARVEST)' _Arguments_: ! HARVEST Shall be a scalar or an array of type `REAL'. _Example_: program test_random_number *************** _See also_: *** 9446,9452 ****  File: gfortran.info, Node: RANDOM_SEED, Next: RAND, Prev: RANDOM_NUMBER, Up: Intrinsic Procedures ! 6.173 `RANDOM_SEED' -- Initialize a pseudo-random number sequence ================================================================= _Description_: --- 10033,10039 ----  File: gfortran.info, Node: RANDOM_SEED, Next: RAND, Prev: RANDOM_NUMBER, Up: Intrinsic Procedures ! 7.177 `RANDOM_SEED' -- Initialize a pseudo-random number sequence ================================================================= _Description_: *************** _Description_: *** 9458,9464 **** random seed based on the system's time. _Standard_: ! F95 and later _Class_: Subroutine --- 10045,10051 ---- random seed based on the system's time. _Standard_: ! Fortran 95 and later _Class_: Subroutine *************** _See also_: *** 9504,9518 ****  File: gfortran.info, Node: RANGE, Next: RAN, Prev: RAND, Up: Intrinsic Procedures ! 6.174 `RANGE' -- Decimal exponent range of a real kind ! ====================================================== _Description_: `RANGE(X)' returns the decimal exponent range in the model of the type of `X'. _Standard_: ! F95 and later _Class_: Inquiry function --- 10091,10105 ----  File: gfortran.info, Node: RANGE, Next: RAN, Prev: RAND, Up: Intrinsic Procedures ! 7.178 `RANGE' -- Decimal exponent range ! ======================================= _Description_: `RANGE(X)' returns the decimal exponent range in the model of the type of `X'. _Standard_: ! Fortran 95 and later _Class_: Inquiry function *************** _Syntax_: *** 9521,9527 **** `RESULT = RANGE(X)' _Arguments_: ! X Shall be of type `REAL' or `COMPLEX'. _Return value_: The return value is of type `INTEGER' and of the default integer --- 10108,10115 ---- `RESULT = RANGE(X)' _Arguments_: ! X Shall be of type `INTEGER', `REAL' or ! `COMPLEX'. _Return value_: The return value is of type `INTEGER' and of the default integer *************** _Example_: *** 9533,9539 ****  File: gfortran.info, Node: REAL, Next: RENAME, Prev: RAN, Up: Intrinsic Procedures ! 6.175 `REAL' -- Convert to real type ==================================== _Description_: --- 10121,10127 ----  File: gfortran.info, Node: REAL, Next: RENAME, Prev: RAN, Up: Intrinsic Procedures ! 7.179 `REAL' -- Convert to real type ==================================== _Description_: *************** _Description_: *** 9542,9548 **** and its use is strongly discouraged. _Standard_: ! F77 and later _Class_: Elemental function --- 10130,10136 ---- and its use is strongly discouraged. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Syntax_: *** 9552,9565 **** `RESULT = REALPART(Z)' _Arguments_: ! X 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 following rules: (A) --- 10140,10152 ---- `RESULT = REALPART(Z)' _Arguments_: ! X 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 following rules: (A) *************** _See also_: *** 9587,9593 ****  File: gfortran.info, Node: RENAME, Next: REPEAT, Prev: REAL, Up: Intrinsic Procedures ! 6.176 `RENAME' -- Rename a file =============================== _Description_: --- 10174,10180 ----  File: gfortran.info, Node: RENAME, Next: REPEAT, Prev: REAL, Up: Intrinsic Procedures ! 7.180 `RENAME' -- Rename a file =============================== _Description_: *************** _See also_: *** 9622,9635 ****  File: gfortran.info, Node: REPEAT, Next: RESHAPE, Prev: RENAME, Up: Intrinsic Procedures ! 6.177 `REPEAT' -- Repeated string concatenation =============================================== _Description_: Concatenates NCOPIES copies of a string. _Standard_: ! F95 and later _Class_: Transformational function --- 10209,10222 ----  File: gfortran.info, Node: REPEAT, Next: RESHAPE, Prev: RENAME, Up: Intrinsic Procedures ! 7.181 `REPEAT' -- Repeated string concatenation =============================================== _Description_: Concatenates NCOPIES copies of a string. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _Syntax_: *** 9638,9645 **** `RESULT = REPEAT(STRING, NCOPIES)' _Arguments_: ! 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 --- 10225,10232 ---- `RESULT = REPEAT(STRING, NCOPIES)' _Arguments_: ! 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 *************** _Example_: *** 9653,9659 ****  File: gfortran.info, Node: RESHAPE, Next: RRSPACING, Prev: REPEAT, Up: Intrinsic Procedures ! 6.178 `RESHAPE' -- Function to reshape an array =============================================== _Description_: --- 10240,10246 ----  File: gfortran.info, Node: RESHAPE, Next: RRSPACING, Prev: REPEAT, Up: Intrinsic Procedures ! 7.182 `RESHAPE' -- Function to reshape an array =============================================== _Description_: *************** _Description_: *** 9662,9668 **** by ORDER. _Standard_: ! F95 and later _Class_: Transformational function --- 10249,10255 ---- by ORDER. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _See also_: *** 9699,9705 ****  File: gfortran.info, Node: RRSPACING, Next: RSHIFT, Prev: RESHAPE, Up: Intrinsic Procedures ! 6.179 `RRSPACING' -- Reciprocal of the relative spacing ======================================================= _Description_: --- 10286,10292 ----  File: gfortran.info, Node: RRSPACING, Next: RSHIFT, Prev: RESHAPE, Up: Intrinsic Procedures ! 7.183 `RRSPACING' -- Reciprocal of the relative spacing ======================================================= _Description_: *************** _Description_: *** 9707,9713 **** model numbers near X. _Standard_: ! F95 and later _Class_: Elemental function --- 10294,10300 ---- model numbers near X. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _See also_: *** 9729,9735 ****  File: gfortran.info, Node: RSHIFT, Next: SCALE, Prev: RRSPACING, Up: Intrinsic Procedures ! 6.180 `RSHIFT' -- Right shift bits ================================== _Description_: --- 10316,10322 ----  File: gfortran.info, Node: RSHIFT, Next: SCALE, Prev: RRSPACING, Up: Intrinsic Procedures ! 7.184 `RSHIFT' -- Right shift bits ================================== _Description_: *************** _Syntax_: *** 9752,9762 **** `RESULT = RSHIFT(I, SHIFT)' _Arguments_: ! 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. _See also_: *note ISHFT::, *note ISHFTC::, *note LSHIFT:: --- 10339,10349 ---- `RESULT = RSHIFT(I, SHIFT)' _Arguments_: ! 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. _See also_: *note ISHFT::, *note ISHFTC::, *note LSHIFT:: *************** _See also_: *** 9765,9778 ****  File: gfortran.info, Node: SCALE, Next: SCAN, Prev: RSHIFT, Up: Intrinsic Procedures ! 6.181 `SCALE' -- Scale a real value =================================== _Description_: `SCALE(X,I)' returns `X * RADIX(X)**I'. _Standard_: ! F95 and later _Class_: Elemental function --- 10352,10365 ----  File: gfortran.info, Node: SCALE, Next: SCAN, Prev: RSHIFT, Up: Intrinsic Procedures ! 7.185 `SCALE' -- Scale a real value =================================== _Description_: `SCALE(X,I)' returns `X * RADIX(X)**I'. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Example_: *** 9799,9805 ****  File: gfortran.info, Node: SCAN, Next: SECNDS, Prev: SCALE, Up: Intrinsic Procedures ! 6.182 `SCAN' -- Scan a string for the presence of a set of characters ===================================================================== _Description_: --- 10386,10392 ----  File: gfortran.info, Node: SCAN, Next: SECNDS, Prev: SCALE, Up: Intrinsic Procedures ! 7.186 `SCAN' -- Scan a string for the presence of a set of characters ===================================================================== _Description_: *************** _Description_: *** 9811,9817 **** character of SET is found in STRING, the result is zero. _Standard_: ! F95 and later _Class_: Elemental function --- 10398,10404 ---- character of SET is found in STRING, the result is zero. _Standard_: ! Fortran 95 and later, with KIND argument Fortran 2003 and later _Class_: Elemental function *************** _Syntax_: *** 9820,9831 **** `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. _Return value_: The return value is of type `INTEGER' and of kind KIND. If KIND is --- 10407,10418 ---- `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. _Return value_: The return value is of type `INTEGER' and of kind KIND. If KIND is *************** _See also_: *** 9844,9850 ****  File: gfortran.info, Node: SECNDS, Next: SECOND, Prev: SCAN, Up: Intrinsic Procedures ! 6.183 `SECNDS' -- Time function =============================== _Description_: --- 10431,10437 ----  File: gfortran.info, Node: SECNDS, Next: SECOND, Prev: SCAN, Up: Intrinsic Procedures ! 7.187 `SECNDS' -- Time function =============================== _Description_: *************** _Example_: *** 9882,9890 **** end program test_secnds  ! File: gfortran.info, Node: SECOND, Next: SELECTED_INT_KIND, Prev: SECNDS, Up: Intrinsic Procedures ! 6.184 `SECOND' -- CPU time function =================================== _Description_: --- 10469,10477 ---- end program test_secnds  ! File: gfortran.info, Node: SECOND, Next: SELECTED_CHAR_KIND, Prev: SECNDS, Up: Intrinsic Procedures ! 7.188 `SECOND' -- CPU time function =================================== _Description_: *************** _See also_: *** 9918,9926 ****  ! File: gfortran.info, Node: SELECTED_INT_KIND, Next: SELECTED_REAL_KIND, Prev: SECOND, Up: Intrinsic Procedures ! 6.185 `SELECTED_INT_KIND' -- Choose integer kind ================================================ _Description_: --- 10505,10547 ----  ! File: gfortran.info, Node: SELECTED_CHAR_KIND, Next: SELECTED_INT_KIND, Prev: SECOND, Up: Intrinsic Procedures ! 7.189 `SELECTED_CHAR_KIND' -- Choose character kind ! =================================================== ! ! _Description_: ! `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 ! "ASCII" and "DEFAULT", which are equivalent. ! ! _Standard_: ! Fortran 2003 and later ! ! _Class_: ! Transformational function ! ! _Syntax_: ! `RESULT = SELECTED_CHAR_KIND(NAME)' ! ! _Arguments_: ! NAME Shall be a scalar and of the default character ! type. ! ! _Example_: ! program ascii_kind ! integer,parameter :: ascii = selected_char_kind("ascii") ! character(kind=ascii, len=26) :: s ! ! s = ascii_"abcdefghijklmnopqrstuvwxyz" ! print *, s ! end program ascii_kind ! !  ! File: gfortran.info, Node: SELECTED_INT_KIND, Next: SELECTED_REAL_KIND, Prev: SELECTED_CHAR_KIND, Up: Intrinsic Procedures ! ! 7.190 `SELECTED_INT_KIND' -- Choose integer kind ================================================ _Description_: *************** _Description_: *** 9930,9936 **** accommodates this range, `SELECTED_INT_KIND' returns -1. _Standard_: ! F95 and later _Class_: Transformational function --- 10551,10557 ---- accommodates this range, `SELECTED_INT_KIND' returns -1. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _Example_: *** 9958,9973 ****  File: gfortran.info, Node: SELECTED_REAL_KIND, Next: SET_EXPONENT, Prev: SELECTED_INT_KIND, Up: Intrinsic Procedures ! 6.186 `SELECTED_REAL_KIND' -- Choose real kind ============================================== _Description_: ! `SELECTED_REAL_KIND(P,R)' return the kind value of a real data type ! with decimal precision greater of at least `P' digits and exponent range greater at least `R'. _Standard_: ! F95 and later _Class_: Transformational function --- 10579,10594 ----  File: gfortran.info, Node: SELECTED_REAL_KIND, Next: SET_EXPONENT, Prev: SELECTED_INT_KIND, Up: Intrinsic Procedures ! 7.191 `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 and exponent range greater at least `R'. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _Example_: *** 10014,10020 ****  File: gfortran.info, Node: SET_EXPONENT, Next: SHAPE, Prev: SELECTED_REAL_KIND, Up: Intrinsic Procedures ! 6.187 `SET_EXPONENT' -- Set the exponent of the model ===================================================== _Description_: --- 10635,10641 ----  File: gfortran.info, Node: SET_EXPONENT, Next: SHAPE, Prev: SELECTED_REAL_KIND, Up: Intrinsic Procedures ! 7.192 `SET_EXPONENT' -- Set the exponent of the model ===================================================== _Description_: *************** _Description_: *** 10022,10028 **** is that that of X and whose exponent part is I. _Standard_: ! F95 and later _Class_: Elemental function --- 10643,10649 ---- is that that of X and whose exponent part is I. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Example_: *** 10050,10063 ****  File: gfortran.info, Node: SHAPE, Next: SIGN, Prev: SET_EXPONENT, Up: Intrinsic Procedures ! 6.188 `SHAPE' -- Determine the shape of an array ================================================ _Description_: Determines the shape of an array. _Standard_: ! F95 and later _Class_: Inquiry function --- 10671,10684 ----  File: gfortran.info, Node: SHAPE, Next: SIGN, Prev: SET_EXPONENT, Up: Intrinsic Procedures ! 7.193 `SHAPE' -- Determine the shape of an array ================================================ _Description_: Determines the shape of an array. _Standard_: ! Fortran 95 and later _Class_: Inquiry function *************** _See also_: *** 10089,10102 ****  File: gfortran.info, Node: SIGN, Next: SIGNAL, Prev: SHAPE, Up: Intrinsic Procedures ! 6.189 `SIGN' -- Sign copying function ===================================== _Description_: `SIGN(A,B)' returns the value of A with the sign of B. _Standard_: ! F77 and later _Class_: Elemental function --- 10710,10723 ----  File: gfortran.info, Node: SIGN, Next: SIGNAL, Prev: SHAPE, Up: Intrinsic Procedures ! 7.194 `SIGN' -- Sign copying function ===================================== _Description_: `SIGN(A,B)' returns the value of A with the sign of B. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Specific names_: *** 10131,10137 ****  File: gfortran.info, Node: SIGNAL, Next: SIN, Prev: SIGN, Up: Intrinsic Procedures ! 6.190 `SIGNAL' -- Signal handling subroutine (or function) ========================================================== _Description_: --- 10752,10758 ----  File: gfortran.info, Node: SIGNAL, Next: SIN, Prev: SIGN, Up: Intrinsic Procedures ! 7.195 `SIGNAL' -- Signal handling subroutine (or function) ========================================================== _Description_: *************** _Example_: *** 10179,10192 ****  File: gfortran.info, Node: SIN, Next: SINH, Prev: SIGNAL, Up: Intrinsic Procedures ! 6.191 `SIN' -- Sine function ============================ _Description_: `SIN(X)' computes the sine of X. _Standard_: ! F77 and later _Class_: Elemental function --- 10800,10813 ----  File: gfortran.info, Node: SIN, Next: SINH, Prev: SIGNAL, Up: Intrinsic Procedures ! 7.196 `SIN' -- Sine function ============================ _Description_: `SIN(X)' computes the sine of X. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Syntax_: *** 10195,10201 **** `RESULT = SIN(X)' _Arguments_: ! X The type shall be `REAL(*)' or `COMPLEX(*)'. _Return value_: The return value has same type and kind as X. --- 10816,10822 ---- `RESULT = SIN(X)' _Arguments_: ! X The type shall be `REAL' or `COMPLEX'. _Return value_: The return value has same type and kind as X. *************** _See also_: *** 10222,10235 ****  File: gfortran.info, Node: SINH, Next: SIZE, Prev: SIN, Up: Intrinsic Procedures ! 6.192 `SINH' -- Hyperbolic sine function ======================================== _Description_: `SINH(X)' computes the hyperbolic sine of X. _Standard_: ! F95 and later _Class_: Elemental function --- 10843,10856 ----  File: gfortran.info, Node: SINH, Next: SIZE, Prev: SIN, Up: Intrinsic Procedures ! 7.197 `SINH' -- Hyperbolic sine function ======================================== _Description_: `SINH(X)' computes the hyperbolic sine of X. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Syntax_: *** 10238,10247 **** `RESULT = SINH(X)' _Arguments_: ! X The type shall be `REAL(*)'. _Return value_: ! The return value is of type `REAL(*)'. _Example_: program test_sinh --- 10859,10868 ---- `RESULT = SINH(X)' _Arguments_: ! X The type shall be `REAL'. _Return value_: ! The return value is of type `REAL'. _Example_: program test_sinh *************** _Example_: *** 10251,10257 **** _Specific names_: Name Argument Return type Standard ! `DSINH(X)' `REAL(8) X' `REAL(8)' F95 and later _See also_: *note ASINH:: --- 10872,10879 ---- _Specific names_: Name Argument Return type Standard ! `DSINH(X)' `REAL(8) X' `REAL(8)' Fortran 95 and ! later _See also_: *note ASINH:: *************** _See also_: *** 10259,10265 ****  File: gfortran.info, Node: SIZE, Next: SIZEOF, Prev: SINH, Up: Intrinsic Procedures ! 6.193 `SIZE' -- Determine the size of an array ============================================== _Description_: --- 10881,10887 ----  File: gfortran.info, Node: SIZE, Next: SIZEOF, Prev: SINH, Up: Intrinsic Procedures ! 7.198 `SIZE' -- Determine the size of an array ============================================== _Description_: *************** _Description_: *** 10267,10273 **** the total number of elements in ARRAY if DIM is absent. _Standard_: ! F95 and later _Class_: Inquiry function --- 10889,10895 ---- the total number of elements in ARRAY if DIM is absent. _Standard_: ! Fortran 95 and later, with KIND argument Fortran 2003 and later _Class_: Inquiry function *************** _Arguments_: *** 10283,10290 **** 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 --- 10905,10912 ---- 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 *************** _See also_: *** 10301,10307 ****  File: gfortran.info, Node: SIZEOF, Next: SLEEP, Prev: SIZE, Up: Intrinsic Procedures ! 6.194 `SIZEOF' -- Size in bytes of an expression ================================================ _Description_: --- 10923,10929 ----  File: gfortran.info, Node: SIZEOF, Next: SLEEP, Prev: SIZE, Up: Intrinsic Procedures ! 7.199 `SIZEOF' -- Size in bytes of an expression ================================================ _Description_: *************** _Example_: *** 10338,10347 **** The example will print `.TRUE.' unless you are using a platform where default `REAL' variables are unusually padded.  File: gfortran.info, Node: SLEEP, Next: SNGL, Prev: SIZEOF, Up: Intrinsic Procedures ! 6.195 `SLEEP' -- Sleep for the specified number of seconds ========================================================== _Description_: --- 10960,10972 ---- The example will print `.TRUE.' unless you are using a platform where default `REAL' variables are unusually padded. + _See also_: + *note C_SIZEOF:: +  File: gfortran.info, Node: SLEEP, Next: SNGL, Prev: SIZEOF, Up: Intrinsic Procedures ! 7.200 `SLEEP' -- Sleep for the specified number of seconds ========================================================== _Description_: *************** _Example_: *** 10368,10374 ****  File: gfortran.info, Node: SNGL, Next: SPACING, Prev: SLEEP, Up: Intrinsic Procedures ! 6.196 `SNGL' -- Convert double precision real to default real ============================================================= _Description_: --- 10993,10999 ----  File: gfortran.info, Node: SNGL, Next: SPACING, Prev: SLEEP, Up: Intrinsic Procedures ! 7.201 `SNGL' -- Convert double precision real to default real ============================================================= _Description_: *************** _Description_: *** 10377,10383 **** type for A. _Standard_: ! F77 and later _Class_: Elemental function --- 11002,11008 ---- type for A. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _See also_: *** 10397,10403 ****  File: gfortran.info, Node: SPACING, Next: SPREAD, Prev: SNGL, Up: Intrinsic Procedures ! 6.197 `SPACING' -- Smallest distance between two numbers of a given type ======================================================================== _Description_: --- 11022,11028 ----  File: gfortran.info, Node: SPACING, Next: SPREAD, Prev: SNGL, Up: Intrinsic Procedures ! 7.202 `SPACING' -- Smallest distance between two numbers of a given type ======================================================================== _Description_: *************** _Description_: *** 10405,10411 **** adjacent number of the same type. _Standard_: ! F95 and later _Class_: Elemental function --- 11030,11036 ---- adjacent number of the same type. _Standard_: ! Fortran 95 and later _Class_: Elemental function *************** _Syntax_: *** 10414,10420 **** `RESULT = SPACING(X)' _Arguments_: ! X Shall be of type `REAL(*)'. _Return value_: The result is of the same type as the input argument X. --- 11039,11045 ---- `RESULT = SPACING(X)' _Arguments_: ! X Shall be of type `REAL'. _Return value_: The result is of the same type as the input argument X. *************** _See also_: *** 10434,10440 ****  File: gfortran.info, Node: SPREAD, Next: SQRT, Prev: SPACING, Up: Intrinsic Procedures ! 6.198 `SPREAD' -- Add a dimension to an array ============================================= _Description_: --- 11059,11065 ----  File: gfortran.info, Node: SPREAD, Next: SQRT, Prev: SPACING, Up: Intrinsic Procedures ! 7.203 `SPREAD' -- Add a dimension to an array ============================================= _Description_: *************** _Description_: *** 10442,10448 **** dimension DIM. _Standard_: ! F95 and later _Class_: Transformational function --- 11067,11073 ---- dimension DIM. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _See also_: *** 10475,10488 ****  File: gfortran.info, Node: SQRT, Next: SRAND, Prev: SPREAD, Up: Intrinsic Procedures ! 6.199 `SQRT' -- Square-root function ==================================== _Description_: `SQRT(X)' computes the square root of X. _Standard_: ! F77 and later _Class_: Elemental function --- 11100,11113 ----  File: gfortran.info, Node: SQRT, Next: SRAND, Prev: SPREAD, Up: Intrinsic Procedures ! 7.204 `SQRT' -- Square-root function ==================================== _Description_: `SQRT(X)' computes the square root of X. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Syntax_: *** 10491,10501 **** `RESULT = SQRT(X)' _Arguments_: ! 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. _Example_: program test_sqrt --- 11116,11126 ---- `RESULT = SQRT(X)' _Arguments_: ! 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. _Example_: program test_sqrt *************** _Example_: *** 10507,10515 **** _Specific names_: Name Argument Return type Standard ! `DSQRT(X)' `REAL(8) X' `REAL(8)' F95 and later ! `CSQRT(X)' `COMPLEX(4) `COMPLEX(4)' F95 and later ! X' `ZSQRT(X)' `COMPLEX(8) `COMPLEX(8)' GNU extension X' `CDSQRT(X)' `COMPLEX(8) `COMPLEX(8)' GNU extension --- 11132,11141 ---- _Specific names_: Name Argument Return type Standard ! `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 *************** _Specific names_: *** 10518,10524 ****  File: gfortran.info, Node: SRAND, Next: STAT, Prev: SQRT, Up: Intrinsic Procedures ! 6.200 `SRAND' -- Reinitialize the random number generator ========================================================= _Description_: --- 11144,11150 ----  File: gfortran.info, Node: SRAND, Next: STAT, Prev: SQRT, Up: Intrinsic Procedures ! 7.205 `SRAND' -- Reinitialize the random number generator ========================================================= _Description_: *************** _Arguments_: *** 10539,10545 **** SEED Shall be a scalar `INTEGER(kind=4)'. _Return value_: ! Does not return. _Example_: See `RAND' and `IRAND' for examples. --- 11165,11171 ---- SEED Shall be a scalar `INTEGER(kind=4)'. _Return value_: ! Does not return anything. _Example_: See `RAND' and `IRAND' for examples. *************** _See also_: *** 10559,10565 ****  File: gfortran.info, Node: STAT, Next: SUM, Prev: SRAND, Up: Intrinsic Procedures ! 6.201 `STAT' -- Get file status =============================== _Description_: --- 11185,11191 ----  File: gfortran.info, Node: STAT, Next: SUM, Prev: SRAND, Up: Intrinsic Procedures ! 7.206 `STAT' -- Get file status =============================== _Description_: *************** _Syntax_: *** 10600,10611 **** `CALL STAT(FILE,BUFF[,STATUS])' _Arguments_: ! FILE The type shall be `CHARACTER(*)', a valid path ! within the file system. BUFF 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 --- 11226,11237 ---- `CALL STAT(FILE,BUFF[,STATUS])' _Arguments_: ! FILE The type shall be `CHARACTER', of the default ! kind and a valid path within the file system. BUFF 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 *************** _See also_: *** 10637,10643 ****  File: gfortran.info, Node: SUM, Next: SYMLNK, Prev: STAT, Up: Intrinsic Procedures ! 6.202 `SUM' -- Sum of array elements ==================================== _Description_: --- 11263,11269 ----  File: gfortran.info, Node: SUM, Next: SYMLNK, Prev: STAT, Up: Intrinsic Procedures ! 7.207 `SUM' -- Sum of array elements ==================================== _Description_: *************** _Description_: *** 10645,10651 **** corresponding element in MASK is `TRUE'. _Standard_: ! F95 and later _Class_: Transformational function --- 11271,11277 ---- corresponding element in MASK is `TRUE'. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _Syntax_: *** 10654,10661 **** `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. --- 11280,11287 ---- `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. *************** _See also_: *** 10684,10690 ****  File: gfortran.info, Node: SYMLNK, Next: SYSTEM, Prev: SUM, Up: Intrinsic Procedures ! 6.203 `SYMLNK' -- Create a symbolic link ======================================== _Description_: --- 11310,11316 ----  File: gfortran.info, Node: SYMLNK, Next: SYSTEM, Prev: SUM, Up: Intrinsic Procedures ! 7.208 `SYMLNK' -- Create a symbolic link ======================================== _Description_: *************** _See also_: *** 10720,10726 ****  File: gfortran.info, Node: SYSTEM, Next: SYSTEM_CLOCK, Prev: SYMLNK, Up: Intrinsic Procedures ! 6.204 `SYSTEM' -- Execute a shell command ========================================= _Description_: --- 11346,11352 ----  File: gfortran.info, Node: SYSTEM, Next: SYSTEM_CLOCK, Prev: SYMLNK, Up: Intrinsic Procedures ! 7.209 `SYSTEM' -- Execute a shell command ========================================= _Description_: *************** _See also_: *** 10752,10758 ****  File: gfortran.info, Node: SYSTEM_CLOCK, Next: TAN, Prev: SYSTEM, Up: Intrinsic Procedures ! 6.205 `SYSTEM_CLOCK' -- Time function ===================================== _Description_: --- 11378,11384 ----  File: gfortran.info, Node: SYSTEM_CLOCK, Next: TAN, Prev: SYSTEM, Up: Intrinsic Procedures ! 7.210 `SYSTEM_CLOCK' -- Time function ===================================== _Description_: *************** _Description_: *** 10765,10771 **** COUNT_RATE and COUNT_MAX are set to zero _Standard_: ! F95 and later _Class_: Subroutine --- 11391,11397 ---- COUNT_RATE and COUNT_MAX are set to zero _Standard_: ! Fortran 95 and later _Class_: Subroutine *************** _See also_: *** 10796,10809 ****  File: gfortran.info, Node: TAN, Next: TANH, Prev: SYSTEM_CLOCK, Up: Intrinsic Procedures ! 6.206 `TAN' -- Tangent function =============================== _Description_: `TAN(X)' computes the tangent of X. _Standard_: ! F77 and later _Class_: Elemental function --- 11422,11435 ----  File: gfortran.info, Node: TAN, Next: TANH, Prev: SYSTEM_CLOCK, Up: Intrinsic Procedures ! 7.211 `TAN' -- Tangent function =============================== _Description_: `TAN(X)' computes the tangent of X. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Syntax_: *** 10812,10821 **** `RESULT = TAN(X)' _Arguments_: ! X The type shall be `REAL(*)'. _Return value_: ! The return value is of type `REAL(*)'. The kind type parameter is the same as X. _Example_: --- 11438,11447 ---- `RESULT = TAN(X)' _Arguments_: ! X The type shall be `REAL'. _Return value_: ! The return value is of type `REAL'. The kind type parameter is the same as X. _Example_: *************** _Example_: *** 10826,10832 **** _Specific names_: Name Argument Return type Standard ! `DTAN(X)' `REAL(8) X' `REAL(8)' F95 and later _See also_: *note ATAN:: --- 11452,11459 ---- _Specific names_: Name Argument Return type Standard ! `DTAN(X)' `REAL(8) X' `REAL(8)' Fortran 95 and ! later _See also_: *note ATAN:: *************** _See also_: *** 10834,10847 ****  File: gfortran.info, Node: TANH, Next: TIME, Prev: TAN, Up: Intrinsic Procedures ! 6.207 `TANH' -- Hyperbolic tangent function =========================================== _Description_: `TANH(X)' computes the hyperbolic tangent of X. _Standard_: ! F77 and later _Class_: Elemental function --- 11461,11474 ----  File: gfortran.info, Node: TANH, Next: TIME, Prev: TAN, Up: Intrinsic Procedures ! 7.212 `TANH' -- Hyperbolic tangent function =========================================== _Description_: `TANH(X)' computes the hyperbolic tangent of X. _Standard_: ! Fortran 77 and later _Class_: Elemental function *************** _Syntax_: *** 10850,10860 **** `X = TANH(X)' _Arguments_: ! X The type shall be `REAL(*)'. _Return value_: ! The return value is of type `REAL(*)' and lies in the range - 1 ! \leq tanh(x) \leq 1 . _Example_: program test_tanh --- 11477,11487 ---- `X = TANH(X)' _Arguments_: ! X The type shall be `REAL'. _Return value_: ! The return value is of type `REAL' and lies in the range - 1 \leq ! tanh(x) \leq 1 . _Example_: program test_tanh *************** _Example_: *** 10864,10870 **** _Specific names_: Name Argument Return type Standard ! `DTANH(X)' `REAL(8) X' `REAL(8)' F95 and later _See also_: *note ATANH:: --- 11491,11498 ---- _Specific names_: Name Argument Return type Standard ! `DTANH(X)' `REAL(8) X' `REAL(8)' Fortran 95 and ! later _See also_: *note ATANH:: *************** _See also_: *** 10872,10878 ****  File: gfortran.info, Node: TIME, Next: TIME8, Prev: TANH, Up: Intrinsic Procedures ! 6.208 `TIME' -- Time function ============================= _Description_: --- 11500,11506 ----  File: gfortran.info, Node: TIME, Next: TIME8, Prev: TANH, Up: Intrinsic Procedures ! 7.213 `TIME' -- Time function ============================= _Description_: *************** _See also_: *** 10910,10916 ****  File: gfortran.info, Node: TIME8, Next: TINY, Prev: TIME, Up: Intrinsic Procedures ! 6.209 `TIME8' -- Time function (64-bit) ======================================= _Description_: --- 11538,11544 ----  File: gfortran.info, Node: TIME8, Next: TINY, Prev: TIME, Up: Intrinsic Procedures ! 7.214 `TIME8' -- Time function (64-bit) ======================================= _Description_: *************** _See also_: *** 10944,10952 ****  ! File: gfortran.info, Node: TINY, Next: TRANSFER, Prev: TIME8, Up: Intrinsic Procedures ! 6.210 `TINY' -- Smallest positive number of a real kind ======================================================= _Description_: --- 11572,11580 ----  ! File: gfortran.info, Node: TINY, Next: TRAILZ, Prev: TIME8, Up: Intrinsic Procedures ! 7.215 `TINY' -- Smallest positive number of a real kind ======================================================= _Description_: *************** _Description_: *** 10954,10960 **** model of the type of `X'. _Standard_: ! F95 and later _Class_: Inquiry function --- 11582,11588 ---- model of the type of `X'. _Standard_: ! Fortran 95 and later _Class_: Inquiry function *************** _Example_: *** 10972,10980 **** See `HUGE' for an example.  ! File: gfortran.info, Node: TRANSFER, Next: TRANSPOSE, Prev: TINY, Up: Intrinsic Procedures ! 6.211 `TRANSFER' -- Transfer bit patterns ========================================= _Description_: --- 11600,11641 ---- See `HUGE' for an example.  ! File: gfortran.info, Node: TRAILZ, Next: TRANSFER, Prev: TINY, Up: Intrinsic Procedures ! 7.216 `TRAILZ' -- Number of trailing zero bits of an integer ! ============================================================ ! ! _Description_: ! `TRAILZ' returns the number of trailing zero bits of an integer. ! ! _Standard_: ! Fortran 2008 and later ! ! _Class_: ! Elemental function ! ! _Syntax_: ! `RESULT = TRAILZ(I)' ! ! _Arguments_: ! 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)'. ! ! _Example_: ! PROGRAM test_trailz ! WRITE (*,*) TRAILZ(8) ! prints 3 ! END PROGRAM ! ! _See also_: ! *note BIT_SIZE::, *note LEADZ:: ! !  ! File: gfortran.info, Node: TRANSFER, Next: TRANSPOSE, Prev: TRAILZ, Up: Intrinsic Procedures ! ! 7.217 `TRANSFER' -- Transfer bit patterns ========================================= _Description_: *************** _Description_: *** 10986,10992 **** type to another. _Standard_: ! F95 and later _Class_: Transformational function --- 11647,11653 ---- type to another. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _Example_: *** 11028,11034 ****  File: gfortran.info, Node: TRANSPOSE, Next: TRIM, Prev: TRANSFER, Up: Intrinsic Procedures ! 6.212 `TRANSPOSE' -- Transpose an array of rank two =================================================== _Description_: --- 11689,11695 ----  File: gfortran.info, Node: TRANSPOSE, Next: TRIM, Prev: TRANSFER, Up: Intrinsic Procedures ! 7.218 `TRANSPOSE' -- Transpose an array of rank two =================================================== _Description_: *************** _Description_: *** 11036,11042 **** the value `MATRIX(j, i)', for all i, j. _Standard_: ! F95 and later _Class_: Transformational function --- 11697,11703 ---- the value `MATRIX(j, i)', for all i, j. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _Arguments_: *** 11049,11068 **** of two. _Return value_: ! The result has the 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 ! 6.213 `TRIM' -- Remove trailing blank characters of a string ============================================================ _Description_: Removes trailing blank characters of a string. _Standard_: ! F95 and later _Class_: Transformational function --- 11710,11729 ---- of two. _Return value_: ! 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 ! 7.219 `TRIM' -- Remove trailing blank characters of a string ============================================================ _Description_: Removes trailing blank characters of a string. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _Syntax_: *** 11071,11081 **** `RESULT = TRIM(STRING)' _Arguments_: ! STRING Shall be a scalar of type `CHARACTER(*)'. _Return value_: ! A scalar of type `CHARACTER(*)' which length is that of STRING ! less the number of trailing blanks. _Example_: PROGRAM test_trim --- 11732,11742 ---- `RESULT = TRIM(STRING)' _Arguments_: ! STRING Shall be a scalar of type `CHARACTER'. _Return value_: ! A scalar of type `CHARACTER' which length is that of STRING less ! the number of trailing blanks. _Example_: PROGRAM test_trim *************** _See also_: *** 11089,11095 ****  File: gfortran.info, Node: TTYNAM, Next: UBOUND, Prev: TRIM, Up: Intrinsic Procedures ! 6.214 `TTYNAM' -- Get the name of a terminal device. ==================================================== _Description_: --- 11750,11756 ----  File: gfortran.info, Node: TTYNAM, Next: UBOUND, Prev: TRIM, Up: Intrinsic Procedures ! 7.220 `TTYNAM' -- Get the name of a terminal device. ==================================================== _Description_: *************** _Syntax_: *** 11110,11117 **** `NAME = TTYNAM(UNIT)' _Arguments_: ! UNIT Shall be a scalar `INTEGER(*)'. ! NAME Shall be of type `CHARACTER(*)'. _Example_: PROGRAM test_ttynam --- 11771,11778 ---- `NAME = TTYNAM(UNIT)' _Arguments_: ! UNIT Shall be a scalar `INTEGER'. ! NAME Shall be of type `CHARACTER'. _Example_: PROGRAM test_ttynam *************** _See also_: *** 11127,11133 ****  File: gfortran.info, Node: UBOUND, Next: UMASK, Prev: TTYNAM, Up: Intrinsic Procedures ! 6.215 `UBOUND' -- Upper dimension bounds of an array ==================================================== _Description_: --- 11788,11794 ----  File: gfortran.info, Node: UBOUND, Next: UMASK, Prev: TTYNAM, Up: Intrinsic Procedures ! 7.221 `UBOUND' -- Upper dimension bounds of an array ==================================================== _Description_: *************** _Description_: *** 11135,11141 **** along the DIM dimension. _Standard_: ! F95 and later _Class_: Inquiry function --- 11796,11802 ---- along the DIM dimension. _Standard_: ! Fortran 95 and later, with KIND argument Fortran 2003 and later _Class_: Inquiry function *************** _Syntax_: *** 11145,11154 **** _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. _Return value_: The return value is of type `INTEGER' and of kind KIND. If KIND is --- 11806,11815 ---- _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. _Return value_: The return value is of type `INTEGER' and of kind KIND. If KIND is *************** _See also_: *** 11167,11173 ****  File: gfortran.info, Node: UMASK, Next: UNLINK, Prev: UBOUND, Up: Intrinsic Procedures ! 6.216 `UMASK' -- Set the file creation mask =========================================== _Description_: --- 11828,11834 ----  File: gfortran.info, Node: UMASK, Next: UNLINK, Prev: UBOUND, Up: Intrinsic Procedures ! 7.222 `UMASK' -- Set the file creation mask =========================================== _Description_: *************** _Syntax_: *** 11184,11198 **** `CALL UMASK(MASK [, OLD])' _Arguments_: ! MASK Shall be a scalar of type `INTEGER(*)'. ! MASK (Optional) Shall be a scalar of type ! `INTEGER(*)'.  File: gfortran.info, Node: UNLINK, Next: UNPACK, Prev: UMASK, Up: Intrinsic Procedures ! 6.217 `UNLINK' -- Remove a file from the file system ==================================================== _Description_: --- 11845,11858 ---- `CALL UMASK(MASK [, OLD])' _Arguments_: ! MASK Shall be a scalar of type `INTEGER'. ! MASK (Optional) Shall be a scalar of type `INTEGER'.  File: gfortran.info, Node: UNLINK, Next: UNPACK, Prev: UMASK, Up: Intrinsic Procedures ! 7.223 `UNLINK' -- Remove a file from the file system ==================================================== _Description_: *************** _See also_: *** 11225,11238 ****  File: gfortran.info, Node: UNPACK, Next: VERIFY, Prev: UNLINK, Up: Intrinsic Procedures ! 6.218 `UNPACK' -- Unpack an array of rank one into an array =========================================================== _Description_: Store the elements of VECTOR in an array of higher rank. _Standard_: ! F95 and later _Class_: Transformational function --- 11885,11898 ----  File: gfortran.info, Node: UNPACK, Next: VERIFY, Prev: UNLINK, Up: Intrinsic Procedures ! 7.224 `UNPACK' -- Unpack an array of rank one into an array =========================================================== _Description_: Store the elements of VECTOR in an array of higher rank. _Standard_: ! Fortran 95 and later _Class_: Transformational function *************** _Arguments_: *** 11245,11251 **** 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 sam type as VECTOR and have the same shape as MASK. _Return value_: --- 11905,11911 ---- 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_: *************** _See also_: *** 11268,11274 ****  File: gfortran.info, Node: VERIFY, Next: XOR, Prev: UNPACK, Up: Intrinsic Procedures ! 6.219 `VERIFY' -- Scan a string for the absence of a set of characters ====================================================================== _Description_: --- 11928,11934 ----  File: gfortran.info, Node: VERIFY, Next: XOR, Prev: UNPACK, Up: Intrinsic Procedures ! 7.225 `VERIFY' -- Scan a string for the absence of a set of characters ====================================================================== _Description_: *************** _Description_: *** 11280,11286 **** all characters of SET are found in STRING, the result is zero. _Standard_: ! F95 and later _Class_: Elemental function --- 11940,11946 ---- all characters of SET are found in STRING, the result is zero. _Standard_: ! Fortran 95 and later, with KIND argument Fortran 2003 and later _Class_: Elemental function *************** _Syntax_: *** 11289,11300 **** `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. _Return value_: The return value is of type `INTEGER' and of kind KIND. If KIND is --- 11949,11960 ---- `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. _Return value_: The return value is of type `INTEGER' and of kind KIND. If KIND is *************** _See also_: *** 11315,11321 ****  File: gfortran.info, Node: XOR, Prev: VERIFY, Up: Intrinsic Procedures ! 6.220 `XOR' -- Bitwise logical exclusive OR =========================================== _Description_: --- 11975,11981 ----  File: gfortran.info, Node: XOR, Prev: VERIFY, Up: Intrinsic Procedures ! 7.226 `XOR' -- Bitwise logical exclusive OR =========================================== _Description_: *************** _Syntax_: *** 11336,11349 **** `RESULT = XOR(X, Y)' _Arguments_: ! X The type shall be either `INTEGER(*)' or ! `LOGICAL'. ! Y The type shall be either `INTEGER(*)' or ! `LOGICAL'. _Return value_: ! The return type is either `INTEGER(*)' or `LOGICAL' after ! cross-promotion of the arguments. _Example_: PROGRAM test_xor --- 11996,12010 ---- `RESULT = XOR(X, Y)' _Arguments_: ! X The type shall be either a scalar `INTEGER' ! type or a scalar `LOGICAL' type. ! Y 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. _Example_: PROGRAM test_xor *************** _Example_: *** 11356,11374 **** END PROGRAM _See also_: ! F95 elemental function: *note IEOR::  File: gfortran.info, Node: Intrinsic Modules, Next: Contributing, Prev: Intrinsic Procedures, Up: Top ! 7 Intrinsic Modules ******************* ! 7.1 `ISO_FORTRAN_ENV' ===================== _Standard_: ! Fortran 2003 The `ISO_FORTRAN_ENV' module provides the following scalar default-integer named constants: --- 12017,12035 ---- END PROGRAM _See also_: ! Fortran 95 elemental function: *note IEOR::  File: gfortran.info, Node: Intrinsic Modules, Next: Contributing, Prev: Intrinsic Procedures, Up: Top ! 8 Intrinsic Modules ******************* ! 8.1 `ISO_FORTRAN_ENV' ===================== _Standard_: ! Fortran 2003 and later The `ISO_FORTRAN_ENV' module provides the following scalar default-integer named constants: *************** default-integer named constants: *** 11377,11390 **** Size in bits of the character storage unit. `ERROR_UNIT': ! Indentifies the preconnected unit used for error reporting. `FILE_STORAGE_SIZE': Size in bits of the file-storage unit. `INPUT_UNIT': ! Indentifies the preconnected unit indentified by the asterisk ! (`*') in `READ' statement. `IOSTAT_END': The value assigned to the variable passed to the IOSTAT= specifier --- 12038,12051 ---- Size in bits of the character storage unit. `ERROR_UNIT': ! Identifies the preconnected unit used for error reporting. `FILE_STORAGE_SIZE': Size in bits of the file-storage unit. `INPUT_UNIT': ! Identifies the preconnected unit identified by the asterisk (`*') ! in `READ' statement. `IOSTAT_END': The value assigned to the variable passed to the IOSTAT= specifier *************** default-integer named constants: *** 11399,11412 **** The size in bits of the numeric storage unit. `OUTPUT_UNIT': ! Indentifies the preconnected unit indentified by the asterisk ! (`*') in `WRITE' statement. ! 7.2 `ISO_C_BINDING' =================== _Standard_: ! Fortran 2003 The following intrinsic procedures are provided by the module; their definition can be found in the section Intrinsic Procedures of this --- 12060,12073 ---- The size in bits of the numeric storage unit. `OUTPUT_UNIT': ! Identifies the preconnected unit identified by the asterisk (`*') ! in `WRITE' statement. ! 8.2 `ISO_C_BINDING' =================== _Standard_: ! Fortran 2003 and later, GNU extensions The following intrinsic procedures are provided by the module; their definition can be found in the section Intrinsic Procedures of this *************** manual. *** 11425,11467 **** The `ISO_C_BINDING' module provides the following named constants of the type integer, which can be used as KIND type parameter. Note that GNU Fortran currently does not support the `C_INT_FAST...' KIND type ! parameters (marked by an asterix (`*') in the list below). The `C_INT_FAST...' parameters have therefore the value -2 and cannot be used as KIND type parameter of the `INTEGER' type. ! Fortran Named constant C type ! 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_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_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_INTMAX_T' `intmax_t' ! `INTEGER' `C_INTPTR_T' `intptr_t' ! `REAL' `C_FLOAT' `float' ! `REAL' `C_DOUBLE' `double' ! `REAL' `C_LONG_DOUBLE' `long double' ! `COMPLEX' `C_FLOAT_COMPLEX' `float _Complex' ! `COMPLEX' `C_DOUBLE_COMPLEX' `double _Complex' ! `COMPLEX' `C_LONG_DOUBLE_COMPLEX' `long double _Complex' ! `LOGICAL' `C_BOOL' `_Bool' ! `CHARACTER' `C_CHAR' `char' ! Additionally, the following `(CHARACTER(KIND=C_CHAR)' are defined. Name C definition Value `C_NULL_CHAR' null character `'\0'' --- 12086,12136 ---- The `ISO_C_BINDING' module provides the following named constants of the type integer, which can be used as KIND type parameter. Note that GNU Fortran currently does not support the `C_INT_FAST...' KIND type ! parameters (marked by an asterisk (`*') in the list below). The `C_INT_FAST...' parameters have therefore the value -2 and cannot be used as KIND type parameter of the `INTEGER' type. ! In addition to the integer named constants required by the Fortran ! 2003 standard, 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'. ! 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' ! `REAL' `C_FLOAT' `float' ! `REAL' `C_DOUBLE' `double' ! `REAL' `C_LONG_DOUBLE' `long double' ! `COMPLEX' `C_FLOAT_COMPLEX' `float _Complex' ! `COMPLEX' `C_DOUBLE_COMPLEX' `double _Complex' ! `COMPLEX' `C_LONG_DOUBLE_COMPLEX' `long double _Complex' ! `LOGICAL' `C_BOOL' `_Bool' ! `CHARACTER' `C_CHAR' `char' ! ! Additionally, the following `(CHARACTER(KIND=C_CHAR))' are defined. Name C definition Value `C_NULL_CHAR' null character `'\0'' *************** Name C definition *** 11473,11483 **** `C_HORIZONTAL_TAB'horizontal tab `'\t'' `C_VERTICAL_TAB'vertical tab `'\v'' ! 7.3 OpenMP Modules `OMP_LIB' and `OMP_LIB_KINDS' ================================================ _Standard_: ! OpenMP Application Program Interface v2.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', --- 12142,12152 ---- `C_HORIZONTAL_TAB'horizontal tab `'\t'' `C_VERTICAL_TAB'vertical tab `'\v'' ! 8.3 OpenMP Modules `OMP_LIB' and `OMP_LIB_KINDS' ================================================ _Standard_: ! OpenMP Application Program Interface v3.0 The OpenMP Fortran runtime library routines are provided both in a form of two Fortran 90 modules, named `OMP_LIB' and `OMP_LIB_KINDS', *************** Introduction: (libgomp)Top. manual, the *** 11487,11493 **** `OMP_LIB_KINDS' module are listed below. For details refer to the actual OpenMP Application Program Interface ! v2.5 (http://www.openmp.org/drupal/mp-documents/spec25.pdf). `OMP_LIB_KINDS' provides the following scalar default-integer named constants: --- 12156,12162 ---- `OMP_LIB_KINDS' module are listed below. For details refer to the actual OpenMP Application Program Interface ! v3.0 (http://www.openmp.org/mp-documents/spec30.pdf). `OMP_LIB_KINDS' provides the following scalar default-integer named constants: *************** constants: *** 11500,11505 **** --- 12169,12176 ---- `omp_nest_lock_kind' + `omp_sched_kind' +  File: gfortran.info, Node: Contributing, Next: Copying, Prev: Intrinsic Modules, Up: Top *************** look up both forms. *** 12929,13035 **** [index] * Menu: * backslash: Fortran Dialect Options. ! (line 47) * fall-intrinsics: Fortran Dialect Options. (line 18) * fbacktrace: Debugging Options. (line 31) ! * fblas-matmul-limit: Code Gen Options. (line 186) * fbounds-check: Code Gen Options. (line 130) * fconvert=CONVERSION: Runtime Options. (line 9) * fcray-pointer: Fortran Dialect Options. ! (line 90) * fd-lines-as-code: Fortran Dialect Options. ! (line 26) * fd-lines-as-comments: Fortran Dialect Options. ! (line 26) * fdefault-double-8: Fortran Dialect Options. - (line 33) - * fdefault-integer-8: Fortran Dialect Options. (line 36) * fdefault-real-8: Fortran Dialect Options. ! (line 40) * fdollar-ok: Fortran Dialect Options. ! (line 44) * fdump-core: Debugging Options. (line 38) * fdump-parse-tree: Debugging Options. (line 10) ! * fexternal-blas: Code Gen Options. (line 178) * ff2c: Code Gen Options. (line 25) * ffixed-line-length-N: Fortran Dialect Options. ! (line 61) * ffpe-trap=LIST: Debugging Options. (line 14) * ffree-form: Fortran Dialect Options. (line 12) * ffree-line-length-N: Fortran Dialect Options. ! (line 74) * fimplicit-none: Fortran Dialect Options. ! (line 85) ! * finit-character: Code Gen Options. (line 210) ! * finit-integer: Code Gen Options. (line 210) ! * finit-local-zero: Code Gen Options. (line 210) ! * finit-logical: Code Gen Options. (line 210) ! * finit-real: Code Gen Options. (line 210) ! * fintrinsic-modules-path DIR: Directory Options. (line 41) * fmax-errors=N: Error and Warning Options. (line 27) * fmax-identifier-length=N: Fortran Dialect Options. ! (line 81) ! * fmax-stack-var-size: Code Gen Options. (line 142) ! * fmax-subrecord-length=LENGTH: Runtime Options. (line 28) * fmodule-private: Fortran Dialect Options. ! (line 56) * fno-automatic: Code Gen Options. (line 15) * fno-fixed-form: Fortran Dialect Options. (line 12) * fno-underscoring: Code Gen Options. (line 54) * fopenmp: Fortran Dialect Options. ! (line 94) ! * fpack-derived: Code Gen Options. (line 156) * frange-check: Fortran Dialect Options. ! (line 102) ! * frecord-marker=LENGTH: Runtime Options. (line 20) ! * frecursive: Code Gen Options. (line 197) ! * frepack-arrays: Code Gen Options. (line 162) * fsecond-underscore: Code Gen Options. (line 113) * fshort-enums <1>: Fortran 2003 status. (line 20) ! * fshort-enums: Code Gen Options. (line 172) ! * fsign-zero: Runtime Options. (line 33) * fsyntax-only: Error and Warning Options. (line 33) * IDIR: Directory Options. (line 14) * JDIR: Directory Options. (line 31) * MDIR: Directory Options. (line 31) * pedantic: Error and Warning Options. (line 38) * pedantic-errors: Error and Warning Options. ! (line 56) * static-libgfortran: Link Options. (line 11) * std=STD option: Fortran Dialect Options. ! (line 114) * Waliasing: Error and Warning Options. ! (line 66) * Wall: Error and Warning Options. ! (line 60) * Wampersand: Error and Warning Options. ! (line 83) * Wcharacter-truncation: Error and Warning Options. ! (line 91) * Wconversion: Error and Warning Options. ! (line 94) * Werror: Error and Warning Options. ! (line 142) * Wimplicit-interface: Error and Warning Options. - (line 97) - * Wnonstd-intrinsics: Error and Warning Options. - (line 103) - * Wsurprising: Error and Warning Options. (line 107) * Wtabs: Error and Warning Options. ! (line 123) * Wunderflow: Error and Warning Options. ! (line 131) * Wunused-parameter: Error and Warning Options. ! (line 135)  File: gfortran.info, Node: Keyword Index, Prev: Option Index, Up: Top --- 13600,13768 ---- [index] * Menu: + * A-PREDICATE=ANSWER: Preprocessing Options. + (line 120) + * APREDICATE=ANSWER: Preprocessing Options. + (line 114) * backslash: Fortran Dialect Options. ! (line 59) ! * C: Preprocessing Options. ! (line 123) ! * CC: Preprocessing Options. ! (line 138) ! * cpp: Preprocessing Options. ! (line 13) ! * dD: Preprocessing Options. ! (line 35) ! * dI: Preprocessing Options. ! (line 51) ! * dM: Preprocessing Options. ! (line 26) ! * dN: Preprocessing Options. ! (line 41) ! * DNAME: Preprocessing Options. ! (line 153) ! * DNAME=DEFINITION: Preprocessing Options. ! (line 156) ! * dU: Preprocessing Options. ! (line 44) ! * falign-commons: Code Gen Options. (line 255) * fall-intrinsics: Fortran Dialect Options. (line 18) * fbacktrace: Debugging Options. (line 31) ! * fblas-matmul-limit: Code Gen Options. (line 214) * fbounds-check: Code Gen Options. (line 130) + * fcheck-array-temporaries: Code Gen Options. (line 144) * fconvert=CONVERSION: Runtime Options. (line 9) * fcray-pointer: Fortran Dialect Options. ! (line 105) * fd-lines-as-code: Fortran Dialect Options. ! (line 29) * fd-lines-as-comments: Fortran Dialect Options. ! (line 29) * fdefault-double-8: Fortran Dialect Options. (line 36) + * fdefault-integer-8: Fortran Dialect Options. + (line 44) * fdefault-real-8: Fortran Dialect Options. ! (line 49) * fdollar-ok: Fortran Dialect Options. ! (line 56) * fdump-core: Debugging Options. (line 38) * fdump-parse-tree: Debugging Options. (line 10) ! * fexternal-blas: Code Gen Options. (line 206) * ff2c: Code Gen Options. (line 25) * ffixed-line-length-N: Fortran Dialect Options. ! (line 76) * ffpe-trap=LIST: Debugging Options. (line 14) * ffree-form: Fortran Dialect Options. (line 12) * ffree-line-length-N: Fortran Dialect Options. ! (line 89) * fimplicit-none: Fortran Dialect Options. ! (line 100) ! * finit-character: Code Gen Options. (line 238) ! * finit-integer: Code Gen Options. (line 238) ! * finit-local-zero: Code Gen Options. (line 238) ! * finit-logical: Code Gen Options. (line 238) ! * finit-real: Code Gen Options. (line 238) ! * fintrinsic-modules-path DIR: Directory Options. (line 40) ! * fmax-array-constructor: Code Gen Options. (line 152) * fmax-errors=N: Error and Warning Options. (line 27) * fmax-identifier-length=N: Fortran Dialect Options. ! (line 96) ! * fmax-stack-var-size: Code Gen Options. (line 170) ! * fmax-subrecord-length=LENGTH: Runtime Options. (line 36) * fmodule-private: Fortran Dialect Options. ! (line 71) * fno-automatic: Code Gen Options. (line 15) * fno-fixed-form: Fortran Dialect Options. (line 12) + * fno-range-check: Runtime Options. (line 20) * fno-underscoring: Code Gen Options. (line 54) * fopenmp: Fortran Dialect Options. ! (line 109) ! * fpack-derived: Code Gen Options. (line 184) ! * fpp: Preprocessing Options. ! (line 13) * frange-check: Fortran Dialect Options. ! (line 117) ! * frecord-marker=LENGTH: Runtime Options. (line 28) ! * frecursive: Code Gen Options. (line 225) ! * frepack-arrays: Code Gen Options. (line 190) * fsecond-underscore: Code Gen Options. (line 113) * fshort-enums <1>: Fortran 2003 status. (line 20) ! * fshort-enums: Code Gen Options. (line 200) ! * fsign-zero: Runtime Options. (line 41) * fsyntax-only: Error and Warning Options. (line 33) + * fworking-directory: Preprocessing Options. + (line 55) + * H: Preprocessing Options. + (line 176) * IDIR: Directory Options. (line 14) + * idirafter DIR: Preprocessing Options. + (line 70) + * imultilib DIR: Preprocessing Options. + (line 77) + * iprefix PREFIX: Preprocessing Options. + (line 81) + * iquote DIR: Preprocessing Options. + (line 90) + * isysroot DIR: Preprocessing Options. + (line 86) + * isystem DIR: Preprocessing Options. + (line 97) * JDIR: Directory Options. (line 31) * MDIR: Directory Options. (line 31) + * nostdinc: Preprocessing Options. + (line 105) + * P: Preprocessing Options. + (line 181) * pedantic: Error and Warning Options. (line 38) * pedantic-errors: Error and Warning Options. ! (line 57) * static-libgfortran: Link Options. (line 11) * std=STD option: Fortran Dialect Options. ! (line 129) ! * UNAME: Preprocessing Options. ! (line 187) ! * undef: Preprocessing Options. ! (line 110) * Waliasing: Error and Warning Options. ! (line 68) ! * Walign-commons: Error and Warning Options. ! (line 165) * Wall: Error and Warning Options. ! (line 61) * Wampersand: Error and Warning Options. ! (line 85) ! * Warray-temporaries: Error and Warning Options. ! (line 93) * Wcharacter-truncation: Error and Warning Options. ! (line 98) * Wconversion: Error and Warning Options. ! (line 104) * Werror: Error and Warning Options. ! (line 171) * Wimplicit-interface: Error and Warning Options. (line 107) + * Wintrinsic-shadow: Error and Warning Options. + (line 152) + * Wintrinsics-std: Error and Warning Options. + (line 113) + * Wline-truncation: Error and Warning Options. + (line 101) + * Wsurprising: Error and Warning Options. + (line 120) * Wtabs: Error and Warning Options. ! (line 140) * Wunderflow: Error and Warning Options. ! (line 148) * Wunused-parameter: Error and Warning Options. ! (line 158)  File: gfortran.info, Node: Keyword Index, Prev: Option Index, Up: Top *************** Keyword Index *** 13041,13047 **** * Menu: * $: Fortran Dialect Options. ! (line 44) * %LOC: Argument list functions. (line 6) * %REF: Argument list functions. --- 13774,13780 ---- * Menu: * $: Fortran Dialect Options. ! (line 56) * %LOC: Argument list functions. (line 6) * %REF: Argument list functions. *************** Keyword Index *** 13049,13055 **** * %VAL: Argument list functions. (line 6) * &: Error and Warning Options. ! (line 83) * [...]: Fortran 2003 status. (line 13) * ABORT: ABORT. (line 6) * ABS: ABS. (line 6) --- 13782,13788 ---- * %VAL: Argument list functions. (line 6) * &: Error and Warning Options. ! (line 85) * [...]: Fortran 2003 status. (line 13) * ABORT: ABORT. (line 6) * ABS: ABS. (line 6) *************** Keyword Index *** 13066,13077 **** * AIMAG: AIMAG. (line 6) * AINT: AINT. (line 6) * ALARM: ALARM. (line 6) ! * ALGAMA: LGAMMA. (line 6) * aliasing: Error and Warning Options. ! (line 66) * ALL: ALL. (line 6) * all warnings: Error and Warning Options. ! (line 60) * ALLOCATABLE components of derived types: Fortran 2003 status. (line 30) * ALLOCATABLE dummy arguments: Fortran 2003 status. (line 26) --- 13799,13813 ---- * AIMAG: AIMAG. (line 6) * AINT: AINT. (line 6) * ALARM: ALARM. (line 6) ! * ALGAMA: LOG_GAMMA. (line 6) * aliasing: Error and Warning Options. ! (line 68) ! * alignment of COMMON blocks <1>: Code Gen Options. (line 255) ! * alignment of COMMON blocks: Error and Warning Options. ! (line 165) * ALL: ALL. (line 6) * all warnings: Error and Warning Options. ! (line 61) * ALLOCATABLE components of derived types: Fortran 2003 status. (line 30) * ALLOCATABLE dummy arguments: Fortran 2003 status. (line 26) *************** Keyword Index *** 13157,13176 **** * ATAN2: ATAN2. (line 6) * Authors: Contributors. (line 6) * backslash: Fortran Dialect Options. ! (line 47) * backtrace: Debugging Options. (line 31) ! * BESJ0: BESJ0. (line 6) ! * BESJ1: BESJ1. (line 6) ! * BESJN: BESJN. (line 6) ! * Bessel function, first kind <1>: BESJN. (line 6) ! * Bessel function, first kind <2>: BESJ1. (line 6) ! * Bessel function, first kind: BESJ0. (line 6) ! * Bessel function, second kind <1>: BESYN. (line 6) ! * Bessel function, second kind <2>: BESY1. (line 6) ! * Bessel function, second kind: BESY0. (line 6) ! * BESY0: BESY0. (line 6) ! * BESY1: BESY1. (line 6) ! * BESYN: BESYN. (line 6) * BIT_SIZE: BIT_SIZE. (line 6) * bits, clear: IBCLR. (line 6) * bits, extract: IBITS. (line 6) --- 13893,13918 ---- * ATAN2: ATAN2. (line 6) * Authors: Contributors. (line 6) * backslash: Fortran Dialect Options. ! (line 59) * backtrace: Debugging Options. (line 31) ! * 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, second kind: BESSEL_Y0. (line 6) ! * BESSEL_J0: BESSEL_J0. (line 6) ! * BESSEL_J1: BESSEL_J1. (line 6) ! * BESSEL_JN: BESSEL_JN. (line 6) ! * BESSEL_Y0: BESSEL_Y0. (line 6) ! * BESSEL_Y1: BESSEL_Y1. (line 6) ! * BESSEL_YN: BESSEL_YN. (line 6) ! * BESY0: BESSEL_Y0. (line 6) ! * BESY1: BESSEL_Y1. (line 6) ! * BESYN: BESSEL_YN. (line 6) * BIT_SIZE: BIT_SIZE. (line 6) * bits, clear: IBCLR. (line 6) * bits, extract: IBITS. (line 6) *************** Keyword Index *** 13202,13207 **** --- 13944,13950 ---- * 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) * CCOS: COS. (line 6) *************** Keyword Index *** 13216,13224 **** * ceiling: ANINT. (line 6) * CEXP: EXP. (line 6) * CHAR: CHAR. (line 6) * character set: Fortran Dialect Options. ! (line 44) * CHDIR: CHDIR. (line 6) * checking subscripts: Code Gen Options. (line 130) * CHMOD: CHMOD. (line 6) * clock ticks <1>: SYSTEM_CLOCK. (line 6) --- 13959,13969 ---- * ceiling: ANINT. (line 6) * CEXP: EXP. (line 6) * CHAR: CHAR. (line 6) + * character kind: SELECTED_CHAR_KIND. (line 6) * character set: Fortran Dialect Options. ! (line 56) * CHDIR: CHDIR. (line 6) + * checking array temporaries: Code Gen Options. (line 144) * checking subscripts: Code Gen Options. (line 130) * CHMOD: CHMOD. (line 6) * clock ticks <1>: SYSTEM_CLOCK. (line 6) *************** Keyword Index *** 13257,13263 **** * Contributing: Contributing. (line 6) * Contributors: Contributors. (line 6) * conversion: Error and Warning Options. ! (line 94) * conversion, to character: CHAR. (line 6) * conversion, to complex <1>: DCMPLX. (line 6) * conversion, to complex <2>: COMPLEX. (line 6) --- 14002,14008 ---- * Contributing: Contributing. (line 6) * Contributors: Contributors. (line 6) * conversion: Error and Warning Options. ! (line 104) * conversion, to character: CHAR. (line 6) * conversion, to complex <1>: DCMPLX. (line 6) * conversion, to complex <2>: COMPLEX. (line 6) *************** Keyword Index *** 13289,13294 **** --- 14034,14041 ---- * cosine, hyperbolic, inverse: ACOSH. (line 6) * cosine, inverse: ACOS. (line 6) * COUNT: COUNT. (line 6) + * CPP <1>: Preprocessing Options. + (line 6) * CPP: Preprocessing and conditional compilation. (line 6) * CPU_TIME: CPU_TIME. (line 6) *************** Keyword Index *** 13317,13328 **** * date, current <2>: FDATE. (line 6) * date, current: DATE_AND_TIME. (line 6) * DATE_AND_TIME: DATE_AND_TIME. (line 6) ! * DBESJ0: BESJ0. (line 6) ! * DBESJ1: BESJ1. (line 6) ! * DBESJN: BESJN. (line 6) ! * DBESY0: BESY0. (line 6) ! * DBESY1: BESY1. (line 6) ! * DBESYN: BESYN. (line 6) * DBLE: DBLE. (line 6) * DCMPLX: DCMPLX. (line 6) * DCONJG: CONJG. (line 6) --- 14064,14075 ---- * date, current <2>: FDATE. (line 6) * date, current: DATE_AND_TIME. (line 6) * DATE_AND_TIME: DATE_AND_TIME. (line 6) ! * DBESJ0: BESSEL_J0. (line 6) ! * DBESJ1: BESSEL_J1. (line 6) ! * DBESJN: BESSEL_JN. (line 6) ! * DBESY0: BESSEL_Y0. (line 6) ! * DBESY1: BESSEL_Y1. (line 6) ! * DBESYN: BESSEL_YN. (line 6) * DBLE: DBLE. (line 6) * DCMPLX: DCMPLX. (line 6) * DCONJG: CONJG. (line 6) *************** Keyword Index *** 13330,13335 **** --- 14077,14084 ---- * DCOSH: COSH. (line 6) * DDIM: DIM. (line 6) * debugging information options: Debugging Options. (line 6) + * debugging, preprocessor: Preprocessing Options. + (line 26) * DECODE: ENCODE and DECODE statements. (line 6) * delayed execution <1>: SLEEP. (line 6) *************** Keyword Index *** 13348,13354 **** * directory, search paths for inclusion: Directory Options. (line 14) * division, modulo: MODULO. (line 6) * division, remainder: MOD. (line 6) ! * DLGAMA: LGAMMA. (line 6) * DLOG: LOG. (line 6) * DLOG10: LOG10. (line 6) * DMAX1: MAX. (line 6) --- 14097,14103 ---- * directory, search paths for inclusion: Directory Options. (line 14) * division, modulo: MODULO. (line 6) * division, remainder: MOD. (line 6) ! * DLGAMA: LOG_GAMMA. (line 6) * DLOG: LOG. (line 6) * DLOG10: LOG10. (line 6) * DMAX1: MAX. (line 6) *************** Keyword Index *** 13383,13402 **** * EPSILON: EPSILON. (line 6) * ERF: ERF. (line 6) * ERFC: ERFC. (line 6) * error function: ERF. (line 6) * error function, complementary: ERFC. (line 6) * errors, limiting: Error and Warning Options. (line 27) * escape characters: Fortran Dialect Options. ! (line 47) * ETIME: ETIME. (line 6) * EXIT: EXIT. (line 6) * EXP: EXP. (line 6) * EXPONENT: EXPONENT. (line 6) * exponential function: EXP. (line 6) * exponential function, inverse <1>: LOG10. (line 6) * exponential function, inverse: LOG. (line 6) ! * expression size: SIZEOF. (line 6) * extensions: Extensions. (line 6) * extensions, implemented: Extensions implemented in GNU Fortran. (line 6) --- 14132,14156 ---- * EPSILON: EPSILON. (line 6) * ERF: ERF. (line 6) * ERFC: ERFC. (line 6) + * ERFC_SCALED: ERFC_SCALED. (line 6) * error function: ERF. (line 6) * error function, complementary: ERFC. (line 6) + * error function, complementary, exponentially-scaled: ERFC_SCALED. + (line 6) * errors, limiting: Error and Warning Options. (line 27) * escape characters: Fortran Dialect Options. ! (line 59) * ETIME: ETIME. (line 6) + * Euclidean distance: HYPOT. (line 6) * EXIT: EXIT. (line 6) * EXP: EXP. (line 6) * EXPONENT: EXPONENT. (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) ! * expression size: C_SIZEOF. (line 6) * extensions: Extensions. (line 6) * extensions, implemented: Extensions implemented in GNU Fortran. (line 6) *************** Keyword Index *** 13460,13469 **** * FTELL: FTELL. (line 6) * g77: GNU Fortran and G77. (line 6) * g77 calling convention: Code Gen Options. (line 25) - * GAMMA <1>: LGAMMA. (line 6) * GAMMA: GAMMA. (line 6) * Gamma function: GAMMA. (line 6) ! * Gamma function, logarithm of: LGAMMA. (line 6) * GCC: GNU Fortran and GCC. (line 6) * GERROR: GERROR. (line 6) * GET_COMMAND: GET_COMMAND. (line 6) --- 14214,14222 ---- * FTELL: FTELL. (line 6) * g77: GNU Fortran and G77. (line 6) * g77 calling convention: Code Gen Options. (line 25) * 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) *************** Keyword Index *** 13498,13503 **** --- 14251,14257 ---- * hyperbolic function, tangent, inverse: ATANH. (line 6) * hyperbolic sine: SINH. (line 6) * hyperbolic tangent: TANH. (line 6) + * HYPOT: HYPOT. (line 6) * I/O item lists: I/O item lists. (line 6) * IABS: ABS. (line 6) * IACHAR: IACHAR. (line 6) *************** Keyword Index *** 13525,13530 **** --- 14279,14286 ---- * INT2: INT2. (line 6) * INT8: INT8. (line 6) * integer kind: SELECTED_INT_KIND. (line 6) + * intrinsic: Error and Warning Options. + (line 152) * intrinsic Modules: Intrinsic Modules. (line 6) * intrinsic procedures: Intrinsic Procedures. (line 6) *************** Keyword Index *** 13547,13552 **** --- 14303,14311 ---- * KILL: KILL. (line 6) * kind: KIND. (line 6) * KIND: KIND. (line 6) + * kind: KIND Type Parameters. + (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) *************** Keyword Index *** 13554,13565 **** --- 14313,14326 ---- * language, dialect options: Fortran Dialect Options. (line 6) * LBOUND: LBOUND. (line 6) + * LEADZ: LEADZ. (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) + * LGAMMA: LOG_GAMMA. (line 6) * LGE: LGE. (line 6) * LGT: LGT. (line 6) * libf2c calling convention: Code Gen Options. (line 25) *************** Keyword Index *** 13574,13579 **** --- 14335,14341 ---- * location of a variable in memory: LOC. (line 6) * LOG: LOG. (line 6) * LOG10: LOG10. (line 6) + * LOG_GAMMA: LOG_GAMMA. (line 6) * logarithmic function <1>: LOG10. (line 6) * logarithmic function: LOG. (line 6) * logarithmic function, inverse: EXP. (line 6) *************** Keyword Index *** 13629,13635 **** * model representation, significant digits: DIGITS. (line 6) * model representation, smallest number: TINY. (line 6) * module entities: Fortran Dialect Options. ! (line 56) * module search path: Directory Options. (line 14) * modulo: MODULO. (line 6) * MODULO: MODULO. (line 6) --- 14391,14397 ---- * model representation, significant digits: DIGITS. (line 6) * model representation, smallest number: TINY. (line 6) * module entities: Fortran Dialect Options. ! (line 71) * module search path: Directory Options. (line 14) * modulo: MODULO. (line 6) * MODULO: MODULO. (line 6) *************** Keyword Index *** 13647,13653 **** * NULL: NULL. (line 6) * OpenMP <1>: OpenMP. (line 6) * OpenMP: Fortran Dialect Options. ! (line 94) * operators, unary: Unary operators. (line 6) * options, code generation: Code Gen Options. (line 6) * options, debugging: Debugging Options. (line 6) --- 14409,14415 ---- * NULL: NULL. (line 6) * OpenMP <1>: OpenMP. (line 6) * OpenMP: Fortran Dialect Options. ! (line 109) * operators, unary: Unary operators. (line 6) * options, code generation: Code Gen Options. (line 6) * options, debugging: Debugging Options. (line 6) *************** Keyword Index *** 13663,13668 **** --- 14425,14432 ---- * options, linking: Link Options. (line 6) * options, negative forms: Invoking GNU Fortran. (line 13) + * options, preprocessor: Preprocessing Options. + (line 6) * options, run-time: Code Gen Options. (line 6) * options, runtime: Runtime Options. (line 6) * options, warnings: Error and Warning Options. *************** Keyword Index *** 13686,13694 **** * PRECISION: PRECISION. (line 6) * Preprocessing: Preprocessing and conditional compilation. (line 6) * PRESENT: PRESENT. (line 6) * private: Fortran Dialect Options. ! (line 56) * procedure pointer, convert C to Fortran: C_LOC. (line 6) * process id: GETPID. (line 6) * PRODUCT: PRODUCT. (line 6) --- 14450,14482 ---- * PRECISION: PRECISION. (line 6) * Preprocessing: Preprocessing and conditional compilation. (line 6) + * preprocessing, assertation: Preprocessing Options. + (line 114) + * preprocessing, define macros: Preprocessing Options. + (line 153) + * preprocessing, include path: Preprocessing Options. + (line 70) + * preprocessing, keep comments: Preprocessing Options. + (line 123) + * preprocessing, no linemarkers: Preprocessing Options. + (line 181) + * preprocessing, undefine macros: Preprocessing Options. + (line 187) + * preprocessor: Preprocessing Options. + (line 6) + * preprocessor, debugging: Preprocessing Options. + (line 26) + * preprocessor, disable: Preprocessing Options. + (line 13) + * preprocessor, enable: Preprocessing Options. + (line 13) + * preprocessor, include file handling: Preprocessing and conditional compilation. + (line 6) + * preprocessor, working directory: Preprocessing Options. + (line 55) * PRESENT: PRESENT. (line 6) * private: Fortran Dialect Options. ! (line 71) * procedure pointer, convert C to Fortran: C_LOC. (line 6) * process id: GETPID. (line 6) * PRODUCT: PRODUCT. (line 6) *************** Keyword Index *** 13727,13733 **** (line 6) * remainder: MOD. (line 6) * RENAME: RENAME. (line 6) ! * repacking arrays: Code Gen Options. (line 162) * REPEAT: REPEAT. (line 6) * RESHAPE: RESHAPE. (line 6) * root: SQRT. (line 6) --- 14515,14521 ---- (line 6) * remainder: MOD. (line 6) * RENAME: RENAME. (line 6) ! * repacking arrays: Code Gen Options. (line 190) * REPEAT: REPEAT. (line 6) * RESHAPE: RESHAPE. (line 6) * root: SQRT. (line 6) *************** Keyword Index *** 13747,13752 **** --- 14535,14541 ---- * SECOND: SECOND. (line 6) * seeding a random number generator <1>: SRAND. (line 6) * seeding a random number generator: RANDOM_SEED. (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) *************** Keyword Index *** 13763,13769 **** * SINH: SINH. (line 6) * SIZE: SIZE. (line 6) * size of a variable, in bits: BIT_SIZE. (line 6) ! * size of an expression: SIZEOF. (line 6) * SIZEOF: SIZEOF. (line 6) * SLEEP: SLEEP. (line 6) * SNGL: SNGL. (line 6) --- 14552,14559 ---- * 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) * SIZEOF: SIZEOF. (line 6) * SLEEP: SLEEP. (line 6) * SNGL: SNGL. (line 6) *************** Keyword Index *** 13806,13812 **** * string, repeat: REPEAT. (line 6) * STRUCTURE: STRUCTURE and RECORD. (line 6) ! * structure packing: Code Gen Options. (line 156) * subscript checking: Code Gen Options. (line 130) * substring position: INDEX intrinsic. (line 6) * SUM: SUM. (line 6) --- 14596,14602 ---- * string, repeat: REPEAT. (line 6) * STRUCTURE: STRUCTURE and RECORD. (line 6) ! * structure packing: Code Gen Options. (line 184) * subscript checking: Code Gen Options. (line 130) * substring position: INDEX intrinsic. (line 6) * SUM: SUM. (line 6) *************** Keyword Index *** 13814,13820 **** * suppressing warnings: Error and Warning Options. (line 6) * symbol names: Fortran Dialect Options. ! (line 44) * symbol names, transforming: Code Gen Options. (line 54) * symbol names, underscores: Code Gen Options. (line 54) * SYMLNK: SYMLNK. (line 6) --- 14604,14610 ---- * suppressing warnings: Error and Warning Options. (line 6) * symbol names: Fortran Dialect Options. ! (line 56) * symbol names, transforming: Code Gen Options. (line 54) * symbol names, underscores: Code Gen Options. (line 54) * SYMLNK: SYMLNK. (line 6) *************** Keyword Index *** 13837,13843 **** * system, working directory: CHDIR. (line 6) * SYSTEM_CLOCK: SYSTEM_CLOCK. (line 6) * tabulators: Error and Warning Options. ! (line 123) * TAN: TAN. (line 6) * tangent: TAN. (line 6) * tangent, hyperbolic: TANH. (line 6) --- 14627,14633 ---- * system, working directory: CHDIR. (line 6) * SYSTEM_CLOCK: SYSTEM_CLOCK. (line 6) * tabulators: Error and Warning Options. ! (line 140) * TAN: TAN. (line 6) * tangent: TAN. (line 6) * tangent, hyperbolic: TANH. (line 6) *************** Keyword Index *** 13868,13873 **** --- 14658,14664 ---- * TINY: TINY. (line 6) * TR 15581: Fortran 2003 status. (line 25) * trace: Debugging Options. (line 31) + * TRAILZ: TRAILZ. (line 6) * TRANSFER: TRANSFER. (line 6) * transforming symbol names: Code Gen Options. (line 54) * transpose: TRANSPOSE. (line 6) *************** Keyword Index *** 13885,13896 **** * UBOUND: UBOUND. (line 6) * UMASK: UMASK. (line 6) * underflow: Error and Warning Options. ! (line 131) * underscore: Code Gen Options. (line 54) * UNLINK: UNLINK. (line 6) * UNPACK: UNPACK. (line 6) * unused parameter: Error and Warning Options. ! (line 135) * USE, INTRINSIC statement: Fortran 2003 status. (line 46) * user id: GETUID. (line 6) * VALUE statement: Fortran 2003 status. (line 39) --- 14676,14687 ---- * UBOUND: UBOUND. (line 6) * UMASK: UMASK. (line 6) * underflow: Error and Warning Options. ! (line 148) * underscore: Code Gen Options. (line 54) * UNLINK: UNLINK. (line 6) * UNPACK: UNPACK. (line 6) * unused parameter: Error and Warning Options. ! (line 158) * USE, INTRINSIC statement: Fortran 2003 status. (line 46) * user id: GETUID. (line 6) * VALUE statement: Fortran 2003 status. (line 39) *************** Keyword Index *** 13898,13933 **** * VERIFY: VERIFY. (line 6) * VOLATILE statement: Fortran 2003 status. (line 41) * warnings, aliasing: Error and Warning Options. ! (line 66) * warnings, all: Error and Warning Options. ! (line 60) * warnings, ampersand: Error and Warning Options. ! (line 83) * warnings, character truncation: Error and Warning Options. ! (line 91) * warnings, conversion: Error and Warning Options. ! (line 94) * warnings, implicit interface: Error and Warning Options. ! (line 97) * warnings, non-standard intrinsics: Error and Warning Options. ! (line 103) * warnings, suppressing: Error and Warning Options. (line 6) * warnings, suspicious code: Error and Warning Options. ! (line 107) * warnings, tabs: Error and Warning Options. ! (line 123) * warnings, to errors: Error and Warning Options. ! (line 142) * warnings, underflow: Error and Warning Options. ! (line 131) * warnings, unused parameter: Error and Warning Options. ! (line 135) * write character, stream mode <1>: FPUTC. (line 6) * write character, stream mode: FPUT. (line 6) * XOR: XOR. (line 6) * ZABS: ABS. (line 6) * ZCOS: COS. (line 6) * ZEXP: EXP. (line 6) * ZLOG: LOG. (line 6) * ZSIN: SIN. (line 6) --- 14689,14736 ---- * VERIFY: VERIFY. (line 6) * VOLATILE statement: Fortran 2003 status. (line 41) * warnings, aliasing: Error and Warning Options. ! (line 68) ! * warnings, alignment of COMMON blocks: Error and Warning Options. ! (line 165) * warnings, all: Error and Warning Options. ! (line 61) * warnings, ampersand: Error and Warning Options. ! (line 85) ! * warnings, array temporaries: Error and Warning Options. ! (line 93) * warnings, character truncation: Error and Warning Options. ! (line 98) * warnings, conversion: Error and Warning Options. ! (line 104) * warnings, implicit interface: Error and Warning Options. ! (line 107) ! * warnings, intrinsic: Error and Warning Options. ! (line 152) ! * warnings, intrinsics of other standards: Error and Warning Options. ! (line 113) ! * warnings, line truncation: Error and Warning Options. ! (line 101) * warnings, non-standard intrinsics: Error and Warning Options. ! (line 113) * warnings, suppressing: Error and Warning Options. (line 6) * warnings, suspicious code: Error and Warning Options. ! (line 120) * warnings, tabs: Error and Warning Options. ! (line 140) * warnings, to errors: Error and Warning Options. ! (line 171) * warnings, underflow: Error and Warning Options. ! (line 148) * warnings, unused parameter: Error and Warning Options. ! (line 158) * write character, stream mode <1>: FPUTC. (line 6) * write character, stream mode: FPUT. (line 6) * XOR: XOR. (line 6) * ZABS: ABS. (line 6) * ZCOS: COS. (line 6) + * zero bits <1>: TRAILZ. (line 6) + * zero bits: LEADZ. (line 6) * ZEXP: EXP. (line 6) * ZLOG: LOG. (line 6) * ZSIN: SIN. (line 6) *************** Keyword Index *** 13936,14226 ****  Tag Table: ! Node: Top2075 ! Node: Introduction3292 ! Node: About GNU Fortran4037 ! Node: GNU Fortran and GCC8095 ! Node: Preprocessing and conditional compilation10185 ! Node: GNU Fortran and G7711626 ! Node: Project Status12199 ! Node: Standards14697 ! Node: Invoking GNU Fortran15354 ! Node: Option Summary17014 ! Node: Fortran Dialect Options19908 ! Node: Error and Warning Options25651 ! Node: Debugging Options31816 ! Node: Directory Options33982 ! Node: Link Options35509 ! Node: Runtime Options36133 ! Node: Code Gen Options37836 ! Node: Environment Variables48403 ! Node: Runtime49006 ! Node: GFORTRAN_STDIN_UNIT50225 ! Node: GFORTRAN_STDOUT_UNIT50592 ! Node: GFORTRAN_STDERR_UNIT50993 ! Node: GFORTRAN_USE_STDERR51391 ! Node: GFORTRAN_TMPDIR51836 ! Node: GFORTRAN_UNBUFFERED_ALL52277 ! Node: GFORTRAN_UNBUFFERED_PRECONNECTED52800 ! Node: GFORTRAN_SHOW_LOCUS53441 ! Node: GFORTRAN_OPTIONAL_PLUS53935 ! Node: GFORTRAN_DEFAULT_RECL54410 ! Node: GFORTRAN_LIST_SEPARATOR54901 ! Node: GFORTRAN_CONVERT_UNIT55510 ! Node: GFORTRAN_ERROR_DUMPCORE58385 ! Node: GFORTRAN_ERROR_BACKTRACE58932 ! Node: Fortran 2003 status59483 ! Node: Extensions61152 ! Node: Extensions implemented in GNU Fortran61746 ! Node: Old-style kind specifications63066 ! Node: Old-style variable initialization63931 ! Node: Extensions to namelist65243 ! Node: X format descriptor without count field67239 ! Node: Commas in FORMAT specifications67766 ! Node: Missing period in FORMAT specifications68283 ! Node: I/O item lists68845 ! Node: BOZ literal constants69234 ! Node: Real array indices71803 ! Node: Unary operators72100 ! Node: Implicitly convert LOGICAL and INTEGER values72514 ! Node: Hollerith constants support73474 ! Node: Cray pointers75246 ! Node: CONVERT specifier80656 ! Node: OpenMP82658 ! Node: Argument list functions84912 ! Node: Extensions not implemented in GNU Fortran86506 ! Node: STRUCTURE and RECORD87357 ! Node: ENCODE and DECODE statements89414 ! Node: Intrinsic Procedures90732 ! Node: Introduction to Intrinsics104024 ! Node: ABORT106337 ! Node: ABS107040 ! Node: ACCESS108532 ! Node: ACHAR110421 ! Node: ACOS111361 ! Node: ACOSH112291 ! Node: ADJUSTL113264 ! Node: ADJUSTR114158 ! Node: AIMAG115058 ! Node: AINT116468 ! Node: ALARM117913 ! Node: ALL119547 ! Node: ALLOCATED121464 ! Node: AND122330 ! Node: ANINT123492 ! Node: ANY124830 ! Node: ASIN126759 ! Node: ASINH127704 ! Node: ASSOCIATED128657 ! Node: ATAN131482 ! Node: ATAN2132316 ! Node: ATANH133595 ! Node: BESJ0134577 ! Node: BESJ1135491 ! Node: BESJN136411 ! Node: BESY0137502 ! Node: BESY1138360 ! Node: BESYN139218 ! Node: BIT_SIZE140363 ! Node: BTEST141112 ! Node: C_ASSOCIATED141960 ! Node: C_FUNLOC143147 ! Node: C_F_PROCPOINTER144509 ! Node: C_F_POINTER146146 ! Node: C_LOC147629 ! Node: CEILING148748 ! Node: CHAR149709 ! Node: CHDIR150796 ! Node: CHMOD152016 ! Node: CMPLX153779 ! Node: COMMAND_ARGUMENT_COUNT155318 ! Node: COMPLEX156208 ! Node: CONJG157363 ! Node: COS158372 ! Node: COSH159585 ! Node: COUNT160403 ! Node: CPU_TIME162230 ! Node: CSHIFT163583 ! Node: CTIME165232 ! Node: DATE_AND_TIME166455 ! Node: DBLE168818 ! Node: DCMPLX169658 ! Node: DFLOAT170897 ! Node: DIGITS171594 ! Node: DIM172538 ! Node: DOT_PRODUCT173674 ! Node: DPROD175104 ! Node: DREAL175823 ! Node: DTIME176487 ! Node: EOSHIFT179293 ! Node: EPSILON181358 ! Node: ERF182054 ! Node: ERFC182851 ! Node: ETIME183666 ! Node: EXIT185890 ! Node: EXP186749 ! Node: EXPONENT187846 ! Node: FDATE188592 ! Node: FLOAT189812 ! Node: FGET190522 ! Node: FGETC192315 ! Node: FLOOR194063 ! Node: FLUSH195005 ! Node: FNUM195643 ! Node: FPUT196365 ! Node: FPUTC197946 ! Node: FRACTION199666 ! Node: FREE200560 ! Node: FSEEK201397 ! Node: FSTAT203691 ! Node: FTELL204755 ! Node: GAMMA205733 ! Node: GERROR206762 ! Node: GETARG207470 ! Node: GET_COMMAND209145 ! Node: GET_COMMAND_ARGUMENT210025 ! Node: GETCWD211421 ! Node: GETENV212358 ! Node: GET_ENVIRONMENT_VARIABLE213522 ! Node: GETGID214456 ! Node: GETLOG214991 ! Node: GETPID215820 ! Node: GETUID216548 ! Node: GMTIME217062 ! Node: HOSTNM218617 ! Node: HUGE219554 ! Node: IACHAR220267 ! Node: IAND221415 ! Node: IARGC222403 ! Node: IBCLR223419 ! Node: IBITS224082 ! Node: IBSET225002 ! Node: ICHAR225660 ! Node: IDATE227613 ! Node: IEOR228631 ! Node: IERRNO229510 ! Node: INDEX intrinsic230065 ! Node: INT231391 ! Node: INT2232915 ! Node: INT8233695 ! Node: IOR234422 ! Node: IRAND235275 ! Node: IS_IOSTAT_END236630 ! Node: IS_IOSTAT_EOR237716 ! Node: ISATTY238832 ! Node: ISHFT239619 ! Node: ISHFTC240601 ! Node: ISNAN241822 ! Node: ITIME242570 ! Node: KILL243586 ! Node: KIND244501 ! Node: LBOUND245339 ! Node: LEN246623 ! Node: LEN_TRIM247689 ! Node: LGAMMA248648 ! Node: LGE249710 ! Node: LGT251013 ! Node: LINK252283 ! Node: LLE253318 ! Node: LLT254615 ! Node: LNBLNK255878 ! Node: LOC256657 ! Node: LOG257388 ! Node: LOG10258590 ! Node: LOGICAL259456 ! Node: LONG260283 ! Node: LSHIFT261054 ! Node: LSTAT262017 ! Node: LTIME263178 ! Node: MALLOC264657 ! Node: MATMUL266321 ! Node: MAX267508 ! Node: MAXEXPONENT269021 ! Node: MAXLOC269830 ! Node: MAXVAL271963 ! Node: MCLOCK273755 ! Node: MCLOCK8274758 ! Node: MERGE275972 ! Node: MIN276733 ! Node: MINEXPONENT278243 ! Node: MINLOC278866 ! Node: MINVAL280999 ! Node: MOD282765 ! Node: MODULO284142 ! Node: MOVE_ALLOC285349 ! Node: MVBITS286407 ! Node: NEAREST287490 ! Node: NEW_LINE288606 ! Node: NINT289391 ! Node: NOT290411 ! Node: NULL290993 ! Node: OR291877 ! Node: PACK293020 ! Node: PERROR295005 ! Node: PRECISION295595 ! Node: PRESENT296414 ! Node: PRODUCT297513 ! Node: RADIX299040 ! Node: RAN299810 ! Node: RAND300266 ! Node: RANDOM_NUMBER301601 ! Node: RANDOM_SEED303331 ! Node: RANGE305207 ! Node: REAL305827 ! Node: RENAME307328 ! Node: REPEAT308347 ! Node: RESHAPE309072 ! Node: RRSPACING310534 ! Node: RSHIFT311220 ! Node: SCALE312191 ! Node: SCAN312958 ! Node: SECNDS314487 ! Node: SECOND315575 ! Node: SELECTED_INT_KIND316450 ! Node: SELECTED_REAL_KIND317606 ! Node: SET_EXPONENT319545 ! Node: SHAPE320534 ! Node: SIGN321640 ! Node: SIGNAL322716 ! Node: SIN324213 ! Node: SINH325254 ! Node: SIZE326011 ! Node: SIZEOF327290 ! Node: SLEEP328549 ! Node: SNGL329106 ! Node: SPACING329770 ! Node: SPREAD330778 ! Node: SQRT331916 ! Node: SRAND333100 ! Node: STAT334259 ! Node: SUM337374 ! Node: SYMLNK338845 ! Node: SYSTEM339977 ! Node: SYSTEM_CLOCK340925 ! Node: TAN342262 ! Node: TANH343043 ! Node: TIME343855 ! Node: TIME8344959 ! Node: TINY346096 ! Node: TRANSFER346691 ! Node: TRANSPOSE348716 ! Node: TRIM349400 ! Node: TTYNAM350256 ! Node: UBOUND351177 ! Node: UMASK352518 ! Node: UNLINK353106 ! Node: UNPACK354083 ! Node: VERIFY355363 ! Node: XOR357060 ! Node: Intrinsic Modules358232 ! Node: Contributing363058 ! Node: Contributors363910 ! Node: Projects365533 ! Node: Proposed Extensions366336 ! Node: Copying368387 ! Node: GNU Free Documentation License405951 ! Node: Funding428363 ! Node: Option Index430888 ! Node: Keyword Index438489  End Tag Table --- 14739,15040 ----  Tag Table: ! Node: Top1996 ! Node: Introduction3311 ! Node: About GNU Fortran4058 ! Node: GNU Fortran and GCC8086 ! Node: Preprocessing and conditional compilation10198 ! Node: GNU Fortran and G7711839 ! Node: Project Status12412 ! Node: Standards14927 ! Node: Invoking GNU Fortran16138 ! Node: Option Summary17861 ! Node: Fortran Dialect Options21349 ! Node: Preprocessing Options28159 ! Node: Error and Warning Options36285 ! Node: Debugging Options43712 ! Node: Directory Options45875 ! Node: Link Options47390 ! Node: Runtime Options48014 ! Node: Code Gen Options50094 ! Node: Environment Variables62319 ! Node: Runtime62924 ! Node: GFORTRAN_STDIN_UNIT64152 ! Node: GFORTRAN_STDOUT_UNIT64519 ! Node: GFORTRAN_STDERR_UNIT64920 ! Node: GFORTRAN_USE_STDERR65318 ! Node: GFORTRAN_TMPDIR65763 ! Node: GFORTRAN_UNBUFFERED_ALL66204 ! Node: GFORTRAN_UNBUFFERED_PRECONNECTED66727 ! Node: GFORTRAN_SHOW_LOCUS67369 ! Node: GFORTRAN_OPTIONAL_PLUS67863 ! Node: GFORTRAN_DEFAULT_RECL68338 ! Node: GFORTRAN_LIST_SEPARATOR68829 ! Node: GFORTRAN_CONVERT_UNIT69438 ! Node: GFORTRAN_ERROR_DUMPCORE72300 ! Node: GFORTRAN_ERROR_BACKTRACE72847 ! Node: Fortran 2003 and 2008 status73398 ! Node: Fortran 2003 status73638 ! Node: Fortran 2008 status75329 ! Node: Compiler Characteristics76298 ! Node: KIND Type Parameters76636 ! Node: Extensions77563 ! Node: Extensions implemented in GNU Fortran78162 ! Node: Old-style kind specifications79496 ! Node: Old-style variable initialization80602 ! Node: Extensions to namelist81914 ! Node: X format descriptor without count field83910 ! Node: Commas in FORMAT specifications84437 ! Node: Missing period in FORMAT specifications84954 ! Node: I/O item lists85516 ! Node: BOZ literal constants85905 ! Node: Real array indices88474 ! Node: Unary operators88771 ! Node: Implicitly convert LOGICAL and INTEGER values89185 ! Node: Hollerith constants support90145 ! Node: Cray pointers91917 ! Node: CONVERT specifier97327 ! Node: OpenMP99325 ! Node: Argument list functions101580 ! Node: Extensions not implemented in GNU Fortran103174 ! Node: STRUCTURE and RECORD104026 ! Node: ENCODE and DECODE statements106082 ! Node: Intrinsic Procedures107400 ! Node: Introduction to Intrinsics121090 ! Node: ABORT123442 ! Node: ABS124199 ! Node: ACCESS125701 ! Node: ACHAR127622 ! Node: ACOS128823 ! Node: ACOSH129821 ! Node: ADJUSTL130698 ! Node: ADJUSTR131639 ! Node: AIMAG132586 ! Node: AINT133906 ! Node: ALARM135378 ! Node: ALL137012 ! Node: ALLOCATED138930 ! Node: AND139811 ! Node: ANINT141108 ! Node: ANY142471 ! Node: ASIN144401 ! Node: ASINH145413 ! Node: ASSOCIATED146295 ! Node: ATAN149300 ! Node: ATAN2150189 ! Node: ATANH151533 ! Node: BESSEL_J0152413 ! Node: BESSEL_J1153457 ! Node: BESSEL_JN154509 ! Node: BESSEL_Y0155676 ! Node: BESSEL_Y1156676 ! Node: BESSEL_YN157676 ! Node: BIT_SIZE158893 ! Node: BTEST159722 ! Node: C_ASSOCIATED160610 ! Node: C_FUNLOC161819 ! Node: C_F_PROCPOINTER163188 ! Node: C_F_POINTER164817 ! Node: C_LOC166235 ! Node: C_SIZEOF167352 ! Node: CEILING168705 ! Node: CHAR169710 ! Node: CHDIR170774 ! Node: CHMOD171942 ! Node: CMPLX173737 ! Node: COMMAND_ARGUMENT_COUNT175201 ! Node: COMPLEX176108 ! Node: CONJG177251 ! Node: COS178261 ! Node: COSH179532 ! Node: COUNT180501 ! Node: CPU_TIME182357 ! Node: CSHIFT183711 ! Node: CTIME185367 ! Node: DATE_AND_TIME186626 ! Node: DBLE189087 ! Node: DCMPLX189911 ! Node: DFLOAT191105 ! Node: DIGITS191799 ! Node: DIM192765 ! Node: DOT_PRODUCT193908 ! Node: DPROD195564 ! Node: DREAL196290 ! Node: DTIME196954 ! Node: EOSHIFT199760 ! Node: EPSILON201833 ! Node: ERF202559 ! Node: ERFC203333 ! Node: ERFC_SCALED204137 ! Node: ETIME204829 ! Node: EXIT207060 ! Node: EXP207919 ! Node: EXPONENT209077 ! Node: FDATE209827 ! Node: FLOAT211102 ! Node: FGET211816 ! Node: FGETC213610 ! Node: FLOOR215378 ! Node: FLUSH216362 ! Node: FNUM217000 ! Node: FPUT217722 ! Node: FPUTC219323 ! Node: FRACTION221063 ! Node: FREE221964 ! Node: FSEEK222801 ! Node: FSTAT225095 ! Node: FTELL226135 ! Node: GAMMA227113 ! Node: GERROR228154 ! Node: GETARG228873 ! Node: GET_COMMAND230637 ! Node: GET_COMMAND_ARGUMENT231583 ! Node: GETCWD233551 ! Node: GETENV234497 ! Node: GET_ENVIRONMENT_VARIABLE235719 ! Node: GETGID237419 ! Node: GETLOG237954 ! Node: GETPID238812 ! Node: GETUID239540 ! Node: GMTIME240054 ! Node: HOSTNM241543 ! Node: HUGE242459 ! Node: HYPOT243178 ! Node: IACHAR243998 ! Node: IAND245178 ! Node: IARGC246165 ! Node: IBCLR247188 ! Node: IBITS247849 ! Node: IBSET248764 ! Node: ICHAR249420 ! Node: IDATE251401 ! Node: IEOR252428 ! Node: IERRNO253304 ! Node: INDEX intrinsic253859 ! Node: INT255205 ! Node: INT2256792 ! Node: INT8257557 ! Node: IOR258269 ! Node: IRAND259119 ! Node: IS_IOSTAT_END260471 ! Node: IS_IOSTAT_EOR261566 ! Node: ISATTY262691 ! Node: ISHFT263474 ! Node: ISHFTC264454 ! Node: ISNAN265670 ! Node: ITIME266418 ! Node: KILL267443 ! Node: KIND268316 ! Node: LBOUND269161 ! Node: LEADZ270473 ! Node: LEN271277 ! Node: LEN_TRIM272368 ! Node: LGE273356 ! Node: LGT274669 ! Node: LINK275946 ! Node: LLE276981 ! Node: LLT278285 ! Node: LNBLNK279555 ! Node: LOC280331 ! Node: LOG281062 ! Node: LOG10282353 ! Node: LOG_GAMMA283325 ! Node: LOGICAL284413 ! Node: LONG285217 ! Node: LSHIFT285973 ! Node: LSTAT286927 ! Node: LTIME288081 ! Node: MALLOC289496 ! Node: MATMUL290956 ! Node: MAX292046 ! Node: MAXEXPONENT293545 ! Node: MAXLOC294361 ! Node: MAXVAL296410 ! Node: MCLOCK298073 ! Node: MCLOCK8299076 ! Node: MERGE300290 ! Node: MIN301032 ! Node: MINEXPONENT302528 ! Node: MINLOC303158 ! Node: MINVAL305207 ! Node: MOD306889 ! Node: MODULO308381 ! Node: MOVE_ALLOC309595 ! Node: MVBITS310619 ! Node: NEAREST311678 ! Node: NEW_LINE312801 ! Node: NINT313572 ! Node: NOT314840 ! Node: NULL315423 ! Node: OR316321 ! Node: PACK317599 ! Node: PERROR319591 ! Node: PRECISION320213 ! Node: PRESENT321039 ! Node: PRODUCT322145 ! Node: RADIX323670 ! Node: RAN324447 ! Node: RAND324903 ! Node: RANDOM_NUMBER326238 ! Node: RANDOM_SEED327956 ! Node: RANGE329839 ! Node: REAL330463 ! Node: RENAME331905 ! Node: REPEAT332924 ! Node: RESHAPE333650 ! Node: RRSPACING335119 ! Node: RSHIFT335812 ! Node: SCALE336774 ! Node: SCAN337548 ! Node: SECNDS339098 ! Node: SECOND340186 ! Node: SELECTED_CHAR_KIND341062 ! Node: SELECTED_INT_KIND342059 ! Node: SELECTED_REAL_KIND343234 ! Node: SET_EXPONENT345173 ! Node: SHAPE346169 ! Node: SIGN347282 ! Node: SIGNAL348365 ! Node: SIN349862 ! Node: SINH350904 ! Node: SIZE351716 ! Node: SIZEOF353024 ! Node: SLEEP354318 ! Node: SNGL354875 ! Node: SPACING355546 ! Node: SPREAD356558 ! Node: SQRT357703 ! Node: SRAND358942 ! Node: STAT360110 ! Node: SUM363222 ! Node: SYMLNK364691 ! Node: SYSTEM365823 ! Node: SYSTEM_CLOCK366771 ! Node: TAN368115 ! Node: TANH368951 ! Node: TIME369818 ! Node: TIME8370922 ! Node: TINY372059 ! Node: TRAILZ372659 ! Node: TRANSFER373444 ! Node: TRANSPOSE375478 ! Node: TRIM376165 ! Node: TTYNAM377022 ! Node: UBOUND377937 ! Node: UMASK379306 ! Node: UNLINK379861 ! Node: UNPACK380838 ! Node: VERIFY382126 ! Node: XOR383842 ! Node: Intrinsic Modules385150 ! Node: Contributing390941 ! Node: Contributors391793 ! Node: Projects393416 ! Node: Proposed Extensions394219 ! Node: Copying396270 ! Node: GNU Free Documentation License433834 ! Node: Funding456246 ! Node: Option Index458771 ! Node: Keyword Index470653  End Tag Table diff -Nrcpad gcc-4.3.3/gcc/fortran/gfortran.texi gcc-4.4.0/gcc/fortran/gfortran.texi *** gcc-4.3.3/gcc/fortran/gfortran.texi Tue Apr 1 18:49:36 2008 --- gcc-4.4.0/gcc/fortran/gfortran.texi Wed Feb 18 18:54:41 2009 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @c %**start of header @setfilename gfortran.info ! @set copyrights-gfortran 1999-2007 @include gcc-common.texi --- 1,7 ---- \input texinfo @c -*-texinfo-*- @c %**start of header @setfilename gfortran.info ! @set copyrights-gfortran 1999-2008 @include gcc-common.texi *************** *** 80,90 **** Copyright @copyright{} @value{copyrights-gfortran} 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.1 or any later version published by the Free Software Foundation; with the ! Invariant Sections being ``GNU General Public License'' and ``Funding ! Free Software'', the Front-Cover ! texts being (a) (see below), and with the Back-Cover Texts being (b) (see below). A copy of the license is included in the section entitled ``GNU Free Documentation License''. --- 80,89 ---- Copyright @copyright{} @value{copyrights-gfortran} 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.2 or any later version published by the Free Software Foundation; with the ! Invariant Sections being ``Funding Free Software'', the Front-Cover ! Texts being (a) (see below), and with the Back-Cover Texts being (b) (see below). A copy of the license is included in the section entitled ``GNU Free Documentation License''. *************** Part I: Invoking GNU Fortran *** 181,187 **** * Runtime:: Influencing runtime behavior with environment variables. Part II: Language Reference ! * Fortran 2003 status:: Fortran 2003 features supported by GNU Fortran. * Extensions:: Language extensions implemented by GNU Fortran. * Intrinsic Procedures:: Intrinsic procedures supported by GNU Fortran. * Intrinsic Modules:: Intrinsic modules supported by GNU Fortran. --- 180,187 ---- * Runtime:: Influencing runtime behavior with environment variables. Part II: Language Reference ! * Fortran 2003 and 2008 status:: Fortran 2003 and 2008 features supported by GNU Fortran. ! * Compiler Characteristics:: KIND type parameters supported. * Extensions:: Language extensions implemented by GNU Fortran. * Intrinsic Procedures:: Intrinsic procedures supported by GNU Fortran. * Intrinsic Modules:: Intrinsic modules supported by GNU Fortran. *************** Part II: Language Reference *** 190,196 **** * Copying:: GNU General Public License says how you can copy and share GNU Fortran. * GNU Free Documentation License:: ! How you can copy and share this manual. * Funding:: How to help assure continued work for free software. * Option Index:: Index of command line options * Keyword Index:: Index of concepts --- 190,196 ---- * Copying:: GNU General Public License says how you can copy and share GNU Fortran. * GNU Free Documentation License:: ! How you can copy and share this manual. * Funding:: How to help assure continued work for free software. * Option Index:: Index of command line options * Keyword Index:: Index of concepts *************** or alternative to, the unix @command{f95 *** 229,235 **** * Preprocessing and conditional compilation:: The Fortran preprocessor * GNU Fortran and G77:: Why we chose to start from scratch. * Project Status:: Status of GNU Fortran, roadmap, proposed extensions. ! * Standards:: Standards supported by GNU Fortran. @end menu --- 229,235 ---- * Preprocessing and conditional compilation:: The Fortran preprocessor * GNU Fortran and G77:: Why we chose to start from scratch. * Project Status:: Status of GNU Fortran, roadmap, proposed extensions. ! * Standards:: Standards supported by GNU Fortran. @end menu *************** it will do everything you expect from an *** 251,257 **** @item Read a user's program, stored in a file and containing instructions written ! in Fortran 77, Fortran 90, Fortran 95 or Fortran 2003. This file contains @dfn{source code}. @item --- 251,257 ---- @item 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 @dfn{source code}. @item *************** code designed to be efficiently translat *** 264,277 **** by a machine such as your computer. Humans usually aren't as good writing machine code as they are at writing Fortran (or C++, Ada, or Java), ! because is easy to make tiny mistakes writing machine code. @item Provide the user with information about the reasons why the compiler is unable to create a binary from the source code. Usually this will be the case if the source code is flawed. ! When writing Fortran, it is easy to make big mistakes. ! The Fortran 90 requires that the compiler can point out mistakes to the user. An incorrect usage of the language causes an @dfn{error message}. --- 264,276 ---- by a machine such as your computer. Humans usually aren't as good writing machine code as they are at writing Fortran (or C++, Ada, or Java), ! because it is easy to make tiny mistakes writing machine code. @item Provide the user with information about the reasons why the compiler is unable to create a binary from the source code. Usually this will be the case if the source code is flawed. ! The Fortran 90 standard requires that the compiler can point out mistakes to the user. An incorrect usage of the language causes an @dfn{error message}. *************** Fortran) for each file in the source cod *** 369,385 **** and linker as appropriate to produce the compiled output. In a copy of GCC which has been compiled with Fortran language support enabled, @command{gcc} will recognize files with @file{.f}, @file{.for}, @file{.ftn}, ! @file{.f90}, @file{.f95}, and @file{.f03} extensions as Fortran source code, ! and compile it accordingly. A @command{gfortran} driver program is also ! provided, which is identical to @command{gcc} except that it automatically ! links the Fortran runtime libraries into the compiled program. Source files with @file{.f}, @file{.for}, @file{.fpp}, @file{.ftn}, @file{.F}, @file{.FOR}, @file{.FPP}, and @file{.FTN} extensions are treated as fixed form. ! Source files with @file{.f90}, @file{.f95}, @file{.f03}, @file{.F90}, ! @file{.F95}, and @file{.F03} extensions are treated as free form. The ! capitalized versions of either form are run through preprocessing. Source files ! with the lower case @file{.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 --- 368,386 ---- and linker as appropriate to produce the compiled output. In a copy of GCC which has been compiled with Fortran language support enabled, @command{gcc} will recognize files with @file{.f}, @file{.for}, @file{.ftn}, ! @file{.f90}, @file{.f95}, @file{.f03} and @file{.f08} extensions as ! Fortran source code, and compile it accordingly. A @command{gfortran} ! driver program is also provided, which is identical to @command{gcc} ! except that it automatically links the Fortran runtime libraries into the ! compiled program. Source files with @file{.f}, @file{.for}, @file{.fpp}, @file{.ftn}, @file{.F}, @file{.FOR}, @file{.FPP}, and @file{.FTN} extensions are treated as fixed form. ! Source files with @file{.f90}, @file{.f95}, @file{.f03}, @file{.f08}, ! @file{.F90}, @file{.F95}, @file{.F03} and @file{.F08} extensions are ! treated as free form. The capitalized versions of either form are run ! through preprocessing. Source files with the lower case @file{.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 *************** Fortran compiler. *** 400,418 **** @cindex FPP @cindex Conditional compilation @cindex Preprocessing 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 ! file extension is @code{.F}, @code{.FOR}, @code{.FTN}, @code{.F90}, ! @code{.F95} or @code{.F03}; otherwise use for fixed-format code the option ! @code{-x f77-cpp-input} and for free-format code @code{-x f95-cpp-input}. ! Invocation of the preprocessor can be suppressed using @code{-x f77} or ! @code{-x f95}. ! If the GNU Fortran invoked the preprocessor, @code{__GFORTRAN__} is defined and @code{__GNUC__}, @code{__GNUC_MINOR__} and @code{__GNUC_PATCHLEVEL__} can be used to determine the version of the compiler. See @ref{Top,,Overview,cpp,The C Preprocessor} for details. --- 401,424 ---- @cindex FPP @cindex Conditional compilation @cindex Preprocessing + @cindex preprocessor, include file handling Many Fortran compilers including GNU Fortran allow passing the source code through a C preprocessor (CPP; sometimes also called the Fortran preprocessor, FPP) to allow for conditional compilation. In the case of GNU Fortran, this is the GNU C Preprocessor in the traditional mode. On systems with case-preserving file names, the preprocessor is automatically invoked if the ! filename extension is @code{.F}, @code{.FOR}, @code{.FTN}, @code{.fpp}, ! @code{.FPP}, @code{.F90}, @code{.F95}, @code{.F03} or @code{.F08}. To manually ! invoke the preprocessor on any file, use @option{-cpp}, to disable ! preprocessing on files where the preprocessor is run automatically, use ! @option{-nocpp}. ! If a preprocessed file includes another file with the Fortran @code{INCLUDE} ! statement, the included file is not preprocessed. To preprocess included ! files, use the equivalent preprocessor statement @code{#include}. ! ! If GNU Fortran invokes the preprocessor, @code{__GFORTRAN__} is defined and @code{__GNUC__}, @code{__GNUC_MINOR__} and @code{__GNUC_PATCHLEVEL__} can be used to determine the version of the compiler. See @ref{Top,,Overview,cpp,The C Preprocessor} for details. *************** The GNU Fortran compiler is able to comp *** 468,477 **** standard-compliant Fortran 95, Fortran 90, and Fortran 77 programs, including a number of standard and non-standard extensions, and can be used on real-world programs. In particular, the supported extensions ! include OpenMP, Cray-style pointers, and several Fortran 2003 features ! such as enumeration, stream I/O, and some of the enhancements to ! allocatable array support from TR 15581. However, it is still under ! development and has a few remaining rough edges. At present, the GNU Fortran compiler passes the @uref{http://www.fortran-2000.com/ArnaudRecipes/fcvs21_f95.html, --- 474,483 ---- standard-compliant Fortran 95, Fortran 90, and Fortran 77 programs, including a number of standard and non-standard extensions, and can be used on real-world programs. In particular, the supported extensions ! include OpenMP, Cray-style pointers, and several Fortran 2003 and Fortran ! 2008 features such as enumeration, stream I/O, and some of the ! enhancements to allocatable array support from TR 15581. However, it is ! still under development and has a few remaining rough edges. At present, the GNU Fortran compiler passes the @uref{http://www.fortran-2000.com/ArnaudRecipes/fcvs21_f95.html, *************** the ISO/IEC TR-15581 enhancements to all *** 516,524 **** the @uref{http://www.openmp.org/drupal/mp-documents/spec25.pdf, OpenMP Application Program Interface v2.5} specification. ! In the future, the GNU Fortran compiler may also support other standard ! variants of and extensions to the Fortran language. These include ! ISO/IEC 1539-1:2004 (Fortran 2003). @c ===================================================================== --- 522,539 ---- the @uref{http://www.openmp.org/drupal/mp-documents/spec25.pdf, OpenMP Application Program Interface v2.5} specification. ! In the future, the GNU Fortran compiler will also support ISO/IEC ! 1539-1:2004 (Fortran 2003) and future Fortran standards. Partial support ! of that standard is already provided; the current status of Fortran 2003 ! support is reported in the @ref{Fortran 2003 status} section of the ! documentation. ! ! The next version of the Fortran standard after Fortran 2003 is currently ! being developed and the GNU Fortran compiler supports some of its new ! features. This support is based on the latest draft of the standard ! (available from @url{http://www.nag.co.uk/sc22wg5/}) and no guarantee of ! future compatibility is made, as the final standard might differ from the ! draft. For more information, see the @ref{Fortran 2008 status} section. @c ===================================================================== *************** This is the default. *** 616,622 **** @section @env{GFORTRAN_UNBUFFERED_PRECONNECTED}---Don't buffer I/O on preconnected units The environment variable named @env{GFORTRAN_UNBUFFERED_PRECONNECTED} controls ! whether I/O on a preconnected unit (i.e STDOUT or STDERR) is unbuffered. If the first letter is @samp{y}, @samp{Y} or @samp{1}, I/O is unbuffered. This will slow down small sequential reads and writes. If the first letter is @samp{n}, @samp{N} or @samp{0}, I/O is buffered. This is the default. --- 631,637 ---- @section @env{GFORTRAN_UNBUFFERED_PRECONNECTED}---Don't buffer I/O on preconnected units The environment variable named @env{GFORTRAN_UNBUFFERED_PRECONNECTED} controls ! whether I/O on a preconnected unit (i.e.@: STDOUT or STDERR) is unbuffered. If the first letter is @samp{y}, @samp{Y} or @samp{1}, I/O is unbuffered. This will slow down small sequential reads and writes. If the first letter is @samp{n}, @samp{N} or @samp{0}, I/O is buffered. This is the default. *************** the modes are the same as for the @code{ *** 682,688 **** @item @code{NATIVE} Use the native format. This is the default. @item @code{SWAP} Swap between little- and big-endian. @item @code{LITTLE_ENDIAN} Use the little-endian format ! for unformatted files. @item @code{BIG_ENDIAN} Use the big-endian format for unformatted files. @end itemize A missing mode for an exception is taken to mean @code{BIG_ENDIAN}. --- 697,703 ---- @item @code{NATIVE} Use the native format. This is the default. @item @code{SWAP} Swap between little- and big-endian. @item @code{LITTLE_ENDIAN} Use the little-endian format ! for unformatted files. @item @code{BIG_ENDIAN} Use the big-endian format for unformatted files. @end itemize A missing mode for an exception is taken to mean @code{BIG_ENDIAN}. *************** was used. *** 758,768 **** @end tex @c --------------------------------------------------------------------- ! @c Fortran 2003 Status @c --------------------------------------------------------------------- @node Fortran 2003 status ! @chapter Fortran 2003 Status Although GNU Fortran focuses on implementing the Fortran 95 standard for the time being, a few Fortran 2003 features are currently --- 773,791 ---- @end tex @c --------------------------------------------------------------------- ! @c Fortran 2003 and 2008 Status @c --------------------------------------------------------------------- + @node Fortran 2003 and 2008 status + @chapter Fortran 2003 and 2008 Status + + @menu + * Fortran 2003 status:: + * Fortran 2008 status:: + @end menu + @node Fortran 2003 status ! @section Fortran 2003 status Although GNU Fortran focuses on implementing the Fortran 95 standard for the time being, a few Fortran 2003 features are currently *************** BOZ as argument of INT, REAL, DBLE and C *** 867,872 **** --- 890,970 ---- @end itemize + @node Fortran 2008 status + @section Fortran 2008 status + + The next version of the Fortran standard after Fortran 2003 is currently + being worked on by the Working Group 5 of Sub-Committee 22 of the Joint + Technical Committee 1 of the International Organization for + Standardization (ISO) and the International Electrotechnical Commission + (IEC). This group is known at @uref{http://www.nag.co.uk/sc22wg5/, WG5}. + The next revision of the Fortran standard is informally referred to as + Fortran 2008, reflecting its planned release year. The GNU Fortran + compiler has support for some of the new features in Fortran 2008. This + support is based on the latest draft, available from + @url{http://www.nag.co.uk/sc22wg5/}. However, as the final standard may + differ from the drafts, no guarantee of backward compatibility can be + made and you should only use it for experimental purposes. + + + @c --------------------------------------------------------------------- + @c Compiler Characteristics + @c --------------------------------------------------------------------- + + @node Compiler Characteristics + @chapter Compiler Characteristics + + @c TODO: Formulate this introduction a little more generally once + @c there is more here than KIND type parameters. + + This chapter describes certain characteristics of the GNU Fortran compiler, + namely the KIND type parameter values supported. + + @menu + * KIND Type Parameters:: + @end menu + + + @node KIND Type Parameters + @section KIND Type Parameters + @cindex kind + + The @code{KIND} type parameters supported by GNU Fortran for the primitive + data types are: + + @table @code + + @item INTEGER + 1, 2, 4, 8*, 16*, default: 4 (1) + + @item LOGICAL + 1, 2, 4, 8*, 16*, default: 4 (1) + + @item REAL + 4, 8, 10**, 16**, default: 4 (2) + + @item COMPLEX + 4, 8, 10**, 16**, default: 4 (2) + + @item CHARACTER + 1, 4, default: 1 + + @end table + + @noindent + * = not available on all systems @* + ** = not available on all systems; additionally 10 and 16 are never + available at the same time @* + (1) Unless -fdefault-integer-8 is used @* + (2) Unless -fdefault-real-8 is used + + @noindent + The @code{KIND} value matches the storage size in bytes, except for + @code{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 @code{SELECT_*_KIND} intrinsics instead of the concrete values. + + @c --------------------------------------------------------------------- @c Extensions @c --------------------------------------------------------------------- *************** by any standard, and those that are supp *** 903,910 **** purely for backward compatibility with legacy compilers. By default, @option{-std=gnu} allows the compiler to accept both types of extensions, but to warn about the use of the latter. Specifying ! either @option{-std=f95} or @option{-std=f2003} disables both types ! of extensions, and @option{-std=legacy} allows both without warning. @menu * Old-style kind specifications:: --- 1001,1009 ---- purely for backward compatibility with legacy compilers. By default, @option{-std=gnu} allows the compiler to accept both types of 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. @menu * Old-style kind specifications:: *************** equivalent to the standard-conforming de *** 946,953 **** TYPESPEC(k) x,y,z @end smallexample @noindent ! where @code{k} is equal to @code{size} for most types, but is equal to ! @code{size/2} for the @code{COMPLEX} type. @node Old-style variable initialization @subsection Old-style variable initialization --- 1045,1058 ---- TYPESPEC(k) x,y,z @end smallexample @noindent ! where @code{k} is the kind parameter suitable for the intended precision. As ! kind parameters are implementation-dependent, use the @code{KIND}, ! @code{SELECTED_INT_KIND} and @code{SELECTED_REAL_KIND} intrinsics to retrieve ! the correct value, for instance @code{REAL*8 x} can be replaced by: ! @smallexample ! INTEGER, PARAMETER :: dbl = KIND(1.0d0) ! REAL(KIND=dbl) :: x ! @end smallexample @node Old-style variable initialization @subsection Old-style variable initialization *************** Valid values for @code{CONVERT} are: *** 1379,1387 **** @item @code{CONVERT='NATIVE'} Use the native format. This is the default. @item @code{CONVERT='SWAP'} Swap between little- and big-endian. @item @code{CONVERT='LITTLE_ENDIAN'} Use the little-endian representation ! for unformatted files. @item @code{CONVERT='BIG_ENDIAN'} Use the big-endian representation for ! unformatted files. @end itemize Using the option could look like this: --- 1484,1492 ---- @item @code{CONVERT='NATIVE'} Use the native format. This is the default. @item @code{CONVERT='SWAP'} Swap between little- and big-endian. @item @code{CONVERT='LITTLE_ENDIAN'} Use the little-endian representation ! for unformatted files. @item @code{CONVERT='BIG_ENDIAN'} Use the big-endian representation for ! unformatted files. @end itemize Using the option could look like this: *************** END SUBROUTINE A1 *** 1457,1463 **** Please note: @itemize @item ! @option{-fopenmp} implies @option{-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. --- 1562,1568 ---- Please note: @itemize @item ! @option{-fopenmp} implies @option{-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. *************** worth a look. *** 1521,1529 **** The long history of the Fortran language, its wide use and broad userbase, the large number of different compiler vendors and the lack of some features crucial to users in the first standards have lead to the ! existence of an important number of 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. --- 1626,1634 ---- The long history of the Fortran language, its wide use and broad userbase, the large number of different compiler vendors and the lack of 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. *************** store_catalog(7).id = 7831 *** 1577,1583 **** store_catalog(7).description = "milk bottle" store_catalog(7).price = 1.2 ! ! We can also manipulates the whole structure store_catalog(12) = pear print *, store_catalog(12) @end example --- 1682,1688 ---- store_catalog(7).description = "milk bottle" store_catalog(7).price = 1.2 ! ! We can also manipulate the whole structure store_catalog(12) = pear print *, store_catalog(12) @end example diff -Nrcpad gcc-4.3.3/gcc/fortran/gfortranspec.c gcc-4.4.0/gcc/fortran/gfortranspec.c *** gcc-4.3.3/gcc/fortran/gfortranspec.c Sun Mar 2 22:55:19 2008 --- gcc-4.4.0/gcc/fortran/gfortranspec.c Tue Feb 3 20:48:23 2009 *************** *** 1,6 **** /* Specific flags and argument handling of the Fortran front-end. ! Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, ! 2008 Free Software Foundation, Inc. This file is part of GCC. --- 1,7 ---- /* Specific flags and argument handling of the Fortran front-end. ! Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, ! 2007, 2008, 2009 ! Free Software Foundation, Inc. This file is part of GCC. *************** lookup_option (Option *xopt, int *xskip, *** 174,179 **** --- 175,182 ---- opt = OPTION_v, skip = 0; else if (text[1] == 'x') opt = OPTION_x, arg = text + 2; + else if (text[1] == 'J') + ; else { if ((skip = WORD_SWITCH_TAKES_ARG (text + 1)) != 0) /* See gcc.c. */ *************** lang_specific_driver (int *in_argc, cons *** 376,382 **** case OPTION_version: printf ("GNU Fortran %s%s\n", pkgversion_string, version_string); ! printf ("Copyright %s 2008 Free Software Foundation, Inc.\n\n", _("(C)")); printf (_("GNU Fortran comes with NO WARRANTY, to the extent permitted by law.\n\ You may redistribute copies of GNU Fortran\n\ --- 379,385 ---- case OPTION_version: printf ("GNU Fortran %s%s\n", pkgversion_string, version_string); ! printf ("Copyright %s 2009 Free Software Foundation, Inc.\n\n", _("(C)")); printf (_("GNU Fortran comes with NO WARRANTY, to the extent permitted by law.\n\ You may redistribute copies of GNU Fortran\n\ *************** For more information about these matters *** 426,443 **** { char *p; if (argv[i][2] == '\0') { ! p = XNEWVEC (char, strlen (argv[i + 1]) + 2); ! p[0] = '-'; ! p[1] = 'J'; ! strcpy (&p[2], argv[i + 1]); ! i++; } else { p = XNEWVEC (char, strlen (argv[i]) + 1); ! strcpy (p, argv[i]); } append_arg (p); continue; --- 429,455 ---- { char *p; + fprintf (stderr, _("Warning: Using -M is deprecated, " + "use -J instead\n")); if (argv[i][2] == '\0') { ! if (i+1 < argc) ! { ! p = XNEWVEC (char, strlen (argv[i + 1]) + 3); ! p[0] = '-'; ! p[1] = 'J'; ! strcpy (&p[2], argv[i + 1]); ! i++; ! } ! else ! fatal ("argument to '%s' missing", argv[i]); } else { p = XNEWVEC (char, strlen (argv[i]) + 1); ! p[0] = '-'; ! p[1] = 'J'; ! strcpy (&p[2], argv[i] + 2); } append_arg (p); continue; diff -Nrcpad gcc-4.3.3/gcc/fortran/interface.c gcc-4.4.0/gcc/fortran/interface.c *** gcc-4.3.3/gcc/fortran/interface.c Sat Jan 10 21:01:14 2009 --- gcc-4.4.0/gcc/fortran/interface.c Thu Feb 26 18:43:50 2009 *************** *** 1,5 **** /* Deal with interfaces. ! Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Deal with interfaces. ! Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught *************** gfc_free_interface (gfc_interface *intr) *** 95,126 **** minus respectively, leaving the rest unchanged. */ static gfc_intrinsic_op ! fold_unary (gfc_intrinsic_op operator) { ! switch (operator) { case INTRINSIC_UPLUS: ! operator = INTRINSIC_PLUS; break; case INTRINSIC_UMINUS: ! operator = INTRINSIC_MINUS; break; default: break; } ! return operator; } /* Match a generic specification. Depending on which type of ! interface is found, the 'name' or 'operator' pointers may be set. This subroutine doesn't return MATCH_NO. */ match gfc_match_generic_spec (interface_type *type, char *name, ! gfc_intrinsic_op *operator) { char buffer[GFC_MAX_SYMBOL_LEN + 1]; match m; --- 95,126 ---- minus respectively, leaving the rest unchanged. */ static gfc_intrinsic_op ! fold_unary (gfc_intrinsic_op op) { ! switch (op) { case INTRINSIC_UPLUS: ! op = INTRINSIC_PLUS; break; case INTRINSIC_UMINUS: ! op = INTRINSIC_MINUS; break; default: break; } ! return op; } /* 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. */ match gfc_match_generic_spec (interface_type *type, char *name, ! gfc_intrinsic_op *op) { char buffer[GFC_MAX_SYMBOL_LEN + 1]; match m; *************** gfc_match_generic_spec (interface_type * *** 129,142 **** if (gfc_match (" assignment ( = )") == MATCH_YES) { *type = INTERFACE_INTRINSIC_OP; ! *operator = INTRINSIC_ASSIGN; return MATCH_YES; } if (gfc_match (" operator ( %o )", &i) == MATCH_YES) { /* Operator i/f */ *type = INTERFACE_INTRINSIC_OP; ! *operator = fold_unary (i); return MATCH_YES; } --- 129,142 ---- if (gfc_match (" assignment ( = )") == MATCH_YES) { *type = INTERFACE_INTRINSIC_OP; ! *op = INTRINSIC_ASSIGN; return MATCH_YES; } if (gfc_match (" operator ( %o )", &i) == MATCH_YES) { /* Operator i/f */ *type = INTERFACE_INTRINSIC_OP; ! *op = fold_unary (i); return MATCH_YES; } *************** gfc_match_interface (void) *** 184,195 **** char name[GFC_MAX_SYMBOL_LEN + 1]; interface_type type; gfc_symbol *sym; ! gfc_intrinsic_op operator; match m; m = gfc_match_space (); ! if (gfc_match_generic_spec (&type, name, &operator) == MATCH_ERROR) return MATCH_ERROR; /* If we're not looking at the end of the statement now, or if this --- 184,195 ---- char name[GFC_MAX_SYMBOL_LEN + 1]; interface_type type; gfc_symbol *sym; ! gfc_intrinsic_op op; match m; m = gfc_match_space (); ! if (gfc_match_generic_spec (&type, name, &op) == MATCH_ERROR) return MATCH_ERROR; /* If we're not looking at the end of the statement now, or if this *************** gfc_match_interface (void) *** 229,235 **** break; case INTERFACE_INTRINSIC_OP: ! current_interface.op = operator; break; case INTERFACE_NAMELESS: --- 229,235 ---- break; case INTERFACE_INTRINSIC_OP: ! current_interface.op = op; break; case INTERFACE_NAMELESS: *************** gfc_match_end_interface (void) *** 275,286 **** { char name[GFC_MAX_SYMBOL_LEN + 1]; interface_type type; ! gfc_intrinsic_op operator; match m; m = gfc_match_space (); ! if (gfc_match_generic_spec (&type, name, &operator) == MATCH_ERROR) return MATCH_ERROR; /* If we're not looking at the end of the statement now, or if this --- 275,286 ---- { char name[GFC_MAX_SYMBOL_LEN + 1]; interface_type type; ! gfc_intrinsic_op op; match m; m = gfc_match_space (); ! if (gfc_match_generic_spec (&type, name, &op) == MATCH_ERROR) return MATCH_ERROR; /* If we're not looking at the end of the statement now, or if this *************** gfc_match_end_interface (void) *** 308,314 **** break; case INTERFACE_INTRINSIC_OP: ! if (type != current_interface.type || operator != current_interface.op) { if (current_interface.op == INTRINSIC_ASSIGN) --- 308,314 ---- break; case INTERFACE_INTRINSIC_OP: ! if (type != current_interface.type || op != current_interface.op) { if (current_interface.op == INTRINSIC_ASSIGN) *************** gfc_compare_derived_types (gfc_symbol *d *** 392,410 **** if (strcmp (dt1->name, dt2->name) != 0) return 0; ! if (dt1->access != dt2->access) return 0; ! if (dt1->pointer != dt2->pointer) return 0; ! if (dt1->dimension != dt2->dimension) return 0; ! if (dt1->allocatable != dt2->allocatable) return 0; ! if (dt1->dimension && gfc_compare_array_spec (dt1->as, dt2->as) == 0) return 0; /* Make sure that link lists do not put this function into an --- 392,410 ---- if (strcmp (dt1->name, dt2->name) != 0) return 0; ! if (dt1->attr.access != dt2->attr.access) return 0; ! if (dt1->attr.pointer != dt2->attr.pointer) return 0; ! if (dt1->attr.dimension != dt2->attr.dimension) return 0; ! if (dt1->attr.allocatable != dt2->attr.allocatable) return 0; ! if (dt1->attr.dimension && gfc_compare_array_spec (dt1->as, dt2->as) == 0) return 0; /* Make sure that link lists do not put this function into an *************** compare_type_rank (gfc_symbol *s1, gfc_s *** 479,485 **** } - static int compare_interfaces (gfc_symbol *, gfc_symbol *, int); static int compare_intr_interfaces (gfc_symbol *, gfc_symbol *); /* Given two symbols that are formal arguments, compare their types --- 479,484 ---- *************** compare_type_rank_if (gfc_symbol *s1, gf *** 492,508 **** if (s1 == NULL || s2 == NULL) return s1 == s2 ? 1 : 0; 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; ! /* At this point, both symbols are procedures. */ ! if ((s1->attr.function == 0 && s1->attr.subroutine == 0) ! || (s2->attr.function == 0 && s2->attr.subroutine == 0)) ! return 0; if (s1->attr.function != s2->attr.function || s1->attr.subroutine != s2->attr.subroutine) return 0; --- 491,516 ---- if (s1 == NULL || s2 == NULL) return s1 == s2 ? 1 : 0; + if (s1 == s2) + return 1; + 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; ! /* 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; ! ! if (s2->attr.function == 0 && s2->attr.subroutine == 0) ! return s2->attr.external == 1 ? compare_type_rank (s1, s2) : 0; + /* Now the type of procedure has been identified. */ if (s1->attr.function != s2->attr.function || s1->attr.subroutine != s2->attr.subroutine) return 0; *************** find_keyword_arg (const char *name, gfc_ *** 538,544 **** interfaces for that operator are legal. */ static void ! check_operator_interface (gfc_interface *intr, gfc_intrinsic_op operator) { gfc_formal_arglist *formal; sym_intent i1, i2; --- 546,552 ---- interfaces for that operator are legal. */ static void ! check_operator_interface (gfc_interface *intr, gfc_intrinsic_op op) { gfc_formal_arglist *formal; sym_intent i1, i2; *************** check_operator_interface (gfc_interface *** 561,567 **** if (sym == NULL) { gfc_error ("Alternate return cannot appear in operator " ! "interface at %L", &intr->where); return; } if (args == 0) --- 569,575 ---- if (sym == NULL) { gfc_error ("Alternate return cannot appear in operator " ! "interface at %L", &intr->sym->declared_at); return; } if (args == 0) *************** check_operator_interface (gfc_interface *** 585,624 **** /* Only +, - and .not. can be unary operators. .not. cannot be a binary operator. */ ! if (args == 0 || args > 2 || (args == 1 && operator != INTRINSIC_PLUS ! && operator != INTRINSIC_MINUS ! && operator != INTRINSIC_NOT) ! || (args == 2 && operator == INTRINSIC_NOT)) { gfc_error ("Operator interface at %L has the wrong number of arguments", ! &intr->where); return; } /* Check that intrinsics are mapped to functions, except INTRINSIC_ASSIGN which should map to a subroutine. */ ! if (operator == INTRINSIC_ASSIGN) { if (!sym->attr.subroutine) { gfc_error ("Assignment operator interface at %L must be " ! "a SUBROUTINE", &intr->where); return; } if (args != 2) { gfc_error ("Assignment operator interface at %L must have " ! "two arguments", &intr->where); return; } if (sym->formal->sym->ts.type != BT_DERIVED ! && sym->formal->next->sym->ts.type != BT_DERIVED && (sym->formal->sym->ts.type == sym->formal->next->sym->ts.type || (gfc_numeric_ts (&sym->formal->sym->ts) && gfc_numeric_ts (&sym->formal->next->sym->ts)))) { gfc_error ("Assignment operator interface at %L must not redefine " ! "an INTRINSIC type assignment", &intr->where); return; } } --- 593,637 ---- /* Only +, - and .not. can be unary operators. .not. cannot be a binary operator. */ ! if (args == 0 || args > 2 || (args == 1 && op != INTRINSIC_PLUS ! && op != INTRINSIC_MINUS ! && op != INTRINSIC_NOT) ! || (args == 2 && op == INTRINSIC_NOT)) { gfc_error ("Operator interface at %L has the wrong number of arguments", ! &intr->sym->declared_at); return; } /* Check that intrinsics are mapped to functions, except INTRINSIC_ASSIGN which should map to a subroutine. */ ! if (op == INTRINSIC_ASSIGN) { if (!sym->attr.subroutine) { gfc_error ("Assignment operator interface at %L must be " ! "a SUBROUTINE", &intr->sym->declared_at); return; } if (args != 2) { gfc_error ("Assignment operator interface at %L must have " ! "two arguments", &intr->sym->declared_at); return; } + + /* Allowed are (per F2003, 12.3.2.1.2 Defined assignments): + - First argument an array with different rank than second, + - Types and kinds do not conform, and + - First argument is of derived type. */ if (sym->formal->sym->ts.type != BT_DERIVED ! && (r1 == 0 || r1 == r2) && (sym->formal->sym->ts.type == sym->formal->next->sym->ts.type || (gfc_numeric_ts (&sym->formal->sym->ts) && gfc_numeric_ts (&sym->formal->next->sym->ts)))) { gfc_error ("Assignment operator interface at %L must not redefine " ! "an INTRINSIC type assignment", &intr->sym->declared_at); return; } } *************** check_operator_interface (gfc_interface *** 627,657 **** if (!sym->attr.function) { gfc_error ("Intrinsic operator interface at %L must be a FUNCTION", ! &intr->where); return; } } /* Check intents on operator interfaces. */ ! if (operator == INTRINSIC_ASSIGN) { if (i1 != INTENT_OUT && i1 != INTENT_INOUT) gfc_error ("First argument of defined assignment at %L must be " ! "INTENT(IN) or INTENT(INOUT)", &intr->where); if (i2 != INTENT_IN) gfc_error ("Second argument of defined assignment at %L must be " ! "INTENT(IN)", &intr->where); } else { if (i1 != INTENT_IN) gfc_error ("First argument of operator interface at %L must be " ! "INTENT(IN)", &intr->where); if (args == 2 && i2 != INTENT_IN) gfc_error ("Second argument of operator interface at %L must be " ! "INTENT(IN)", &intr->where); } /* From now on, all we have to do is check that the operator definition --- 640,670 ---- if (!sym->attr.function) { gfc_error ("Intrinsic operator interface at %L must be a FUNCTION", ! &intr->sym->declared_at); return; } } /* Check intents on operator interfaces. */ ! if (op == INTRINSIC_ASSIGN) { if (i1 != INTENT_OUT && i1 != INTENT_INOUT) gfc_error ("First argument of defined assignment at %L must be " ! "INTENT(OUT) or INTENT(INOUT)", &intr->sym->declared_at); if (i2 != INTENT_IN) gfc_error ("Second argument of defined assignment at %L must be " ! "INTENT(IN)", &intr->sym->declared_at); } else { if (i1 != INTENT_IN) gfc_error ("First argument of operator interface at %L must be " ! "INTENT(IN)", &intr->sym->declared_at); if (args == 2 && i2 != INTENT_IN) gfc_error ("Second argument of operator interface at %L must be " ! "INTENT(IN)", &intr->sym->declared_at); } /* From now on, all we have to do is check that the operator definition *************** check_operator_interface (gfc_interface *** 669,675 **** ((t) == BT_INTEGER || (t) == BT_REAL || (t) == BT_COMPLEX) /* Unary ops are easy, do them first. */ ! if (operator == INTRINSIC_NOT) { if (t1 == BT_LOGICAL) goto bad_repl; --- 682,688 ---- ((t) == BT_INTEGER || (t) == BT_REAL || (t) == BT_COMPLEX) /* Unary ops are easy, do them first. */ ! if (op == INTRINSIC_NOT) { if (t1 == BT_LOGICAL) goto bad_repl; *************** check_operator_interface (gfc_interface *** 677,683 **** return; } ! if (args == 1 && (operator == INTRINSIC_PLUS || operator == INTRINSIC_MINUS)) { if (IS_NUMERIC_TYPE (t1)) goto bad_repl; --- 690,696 ---- return; } ! if (args == 1 && (op == INTRINSIC_PLUS || op == INTRINSIC_MINUS)) { if (IS_NUMERIC_TYPE (t1)) goto bad_repl; *************** check_operator_interface (gfc_interface *** 697,703 **** if (r1 != r2 && r1 != 0 && r2 != 0) return; ! switch (operator) { case INTRINSIC_EQ: case INTRINSIC_EQ_OS: --- 710,716 ---- if (r1 != r2 && r1 != 0 && r2 != 0) return; ! switch (op) { case INTRINSIC_EQ: case INTRINSIC_EQ_OS: *************** count_types_test (gfc_formal_arglist *f1 *** 790,796 **** /* Build an array of integers that gives the same integer to arguments of the same type/rank. */ ! arg = gfc_getmem (n1 * sizeof (arginfo)); f = f1; for (i = 0; i < n1; i++, f = f->next) --- 803,809 ---- /* Build an array of integers that gives the same integer to arguments of the same type/rank. */ ! arg = XCNEWVEC (arginfo, n1); f = f1; for (i = 0; i < n1; i++, f = f->next) *************** generic_correspondence (gfc_formal_argli *** 949,956 **** We return nonzero if there exists an actual argument list that would be ambiguous between the two interfaces, zero otherwise. */ ! static int ! compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag) { gfc_formal_arglist *f1, *f2; --- 962,969 ---- We return nonzero if there exists an actual argument list that would be ambiguous between the two interfaces, zero otherwise. */ ! int ! gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag) { gfc_formal_arglist *f1, *f2; *************** check_interface1 (gfc_interface *p, gfc_ *** 1168,1174 **** if (p->sym->name == q->sym->name && p->sym->module == q->sym->module) continue; ! if (compare_interfaces (p->sym, q->sym, generic_flag)) { if (referenced) { --- 1181,1187 ---- if (p->sym->name == q->sym->name && p->sym->module == q->sym->module) continue; ! if (gfc_compare_interfaces (p->sym, q->sym, generic_flag)) { if (referenced) { *************** check_uop_interfaces (gfc_user_op *uop) *** 1238,1244 **** gfc_namespace *ns; sprintf (interface_name, "operator interface '%s'", uop->name); ! if (check_interface0 (uop->operator, interface_name)) return; for (ns = gfc_current_ns; ns; ns = ns->parent) --- 1251,1257 ---- gfc_namespace *ns; sprintf (interface_name, "operator interface '%s'", uop->name); ! if (check_interface0 (uop->op, interface_name)) return; for (ns = gfc_current_ns; ns; ns = ns->parent) *************** check_uop_interfaces (gfc_user_op *uop) *** 1247,1253 **** if (uop2 == NULL) continue; ! check_interface1 (uop->operator, uop2->operator, 0, interface_name, true); } } --- 1260,1266 ---- if (uop2 == NULL) continue; ! check_interface1 (uop->op, uop2->op, 0, interface_name, true); } } *************** gfc_check_interfaces (gfc_namespace *ns) *** 1283,1358 **** sprintf (interface_name, "intrinsic '%s' operator", gfc_op2string (i)); ! if (check_interface0 (ns->operator[i], interface_name)) continue; ! check_operator_interface (ns->operator[i], i); for (ns2 = ns; ns2; ns2 = ns2->parent) { ! if (check_interface1 (ns->operator[i], ns2->operator[i], 0, interface_name, true)) goto done; switch (i) { case INTRINSIC_EQ: ! if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_EQ_OS], 0, interface_name, true)) goto done; break; case INTRINSIC_EQ_OS: ! if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_EQ], 0, interface_name, true)) goto done; break; case INTRINSIC_NE: ! if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_NE_OS], 0, interface_name, true)) goto done; break; case INTRINSIC_NE_OS: ! if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_NE], 0, interface_name, true)) goto done; break; case INTRINSIC_GT: ! if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_GT_OS], 0, interface_name, true)) goto done; break; case INTRINSIC_GT_OS: ! if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_GT], 0, interface_name, true)) goto done; break; case INTRINSIC_GE: ! if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_GE_OS], 0, interface_name, true)) goto done; break; case INTRINSIC_GE_OS: ! if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_GE], 0, interface_name, true)) goto done; break; case INTRINSIC_LT: ! if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_LT_OS], 0, interface_name, true)) goto done; break; case INTRINSIC_LT_OS: ! if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_LT], 0, interface_name, true)) goto done; break; case INTRINSIC_LE: ! if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_LE_OS], 0, interface_name, true)) goto done; break; case INTRINSIC_LE_OS: ! if (check_interface1 (ns->operator[i], ns2->operator[INTRINSIC_LE], 0, interface_name, true)) goto done; break; --- 1296,1371 ---- sprintf (interface_name, "intrinsic '%s' operator", gfc_op2string (i)); ! if (check_interface0 (ns->op[i], interface_name)) continue; ! check_operator_interface (ns->op[i], i); for (ns2 = ns; ns2; ns2 = ns2->parent) { ! if (check_interface1 (ns->op[i], ns2->op[i], 0, interface_name, true)) goto done; switch (i) { case INTRINSIC_EQ: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_EQ_OS], 0, interface_name, true)) goto done; break; case INTRINSIC_EQ_OS: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_EQ], 0, interface_name, true)) goto done; break; case INTRINSIC_NE: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_NE_OS], 0, interface_name, true)) goto done; break; case INTRINSIC_NE_OS: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_NE], 0, interface_name, true)) goto done; break; case INTRINSIC_GT: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_GT_OS], 0, interface_name, true)) goto done; break; case INTRINSIC_GT_OS: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_GT], 0, interface_name, true)) goto done; break; case INTRINSIC_GE: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_GE_OS], 0, interface_name, true)) goto done; break; case INTRINSIC_GE_OS: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_GE], 0, interface_name, true)) goto done; break; case INTRINSIC_LT: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_LT_OS], 0, interface_name, true)) goto done; break; case INTRINSIC_LT_OS: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_LT], 0, interface_name, true)) goto done; break; case INTRINSIC_LE: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_LE_OS], 0, interface_name, true)) goto done; break; case INTRINSIC_LE_OS: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_LE], 0, interface_name, true)) goto done; break; *************** compare_parameter (gfc_symbol *formal, g *** 1455,1461 **** if (!compare_intr_interfaces (formal, actual->symtree->n.sym)) goto proc_fail; } ! else if (!compare_interfaces (formal, actual->symtree->n.sym, 0)) goto proc_fail; return 1; --- 1468,1474 ---- if (!compare_intr_interfaces (formal, actual->symtree->n.sym)) goto proc_fail; } ! else if (!gfc_compare_interfaces (formal, actual->symtree->n.sym, 0)) goto proc_fail; return 1; *************** compare_parameter_protected (gfc_symbol *** 1560,1566 **** if (actual->expr_type != EXPR_VARIABLE) return 1; ! if (!actual->symtree->n.sym->attr.protected) return 1; if (!actual->symtree->n.sym->attr.use_assoc) --- 1573,1579 ---- if (actual->expr_type != EXPR_VARIABLE) return 1; ! if (!actual->symtree->n.sym->attr.is_protected) return 1; if (!actual->symtree->n.sym->attr.use_assoc) *************** has_vector_subscript (gfc_expr *e) *** 1816,1824 **** static int compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, ! int ranks_must_agree, int is_elemental, locus *where) { ! gfc_actual_arglist **new, *a, *actual, temp; gfc_formal_arglist *f; int i, n, na; unsigned long actual_size, formal_size; --- 1829,1837 ---- static int compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, ! int ranks_must_agree, int is_elemental, locus *where) { ! gfc_actual_arglist **new_arg, *a, *actual, temp; gfc_formal_arglist *f; int i, n, na; unsigned long actual_size, formal_size; *************** compare_actual_formal (gfc_actual_arglis *** 1832,1841 **** for (f = formal; f; f = f->next) n++; ! new = (gfc_actual_arglist **) alloca (n * sizeof (gfc_actual_arglist *)); for (i = 0; i < n; i++) ! new[i] = NULL; na = 0; f = formal; --- 1845,1854 ---- for (f = formal; f; f = f->next) n++; ! new_arg = (gfc_actual_arglist **) alloca (n * sizeof (gfc_actual_arglist *)); for (i = 0; i < n; i++) ! new_arg[i] = NULL; na = 0; f = formal; *************** compare_actual_formal (gfc_actual_arglis *** 1863,1869 **** return 0; } ! if (new[i] != NULL) { if (where) gfc_error ("Keyword argument '%s' at %L is already associated " --- 1876,1882 ---- return 0; } ! if (new_arg[i] != NULL) { if (where) gfc_error ("Keyword argument '%s' at %L is already associated " *************** compare_actual_formal (gfc_actual_arglis *** 1954,1959 **** --- 1967,1983 ---- return 0; } + /* Satisfy 12.4.1.3 by ensuring that a procedure pointer actual argument + is provided for a procedure pointer formal argument. */ + if (f->sym->attr.proc_pointer + && !a->expr->symtree->n.sym->attr.proc_pointer) + { + if (where) + gfc_error ("Expected a procedure pointer for argument '%s' at %L", + f->sym->name, &a->expr->where); + return 0; + } + /* Satisfy 12.4.1.2 by ensuring that a procedure actual argument is provided for a procedure formal argument. */ if (a->expr->ts.type != BT_PROCEDURE *************** compare_actual_formal (gfc_actual_arglis *** 2097,2110 **** if (a == actual) na = i; ! new[i++] = a; } /* Make sure missing actual arguments are optional. */ i = 0; for (f = formal; f; f = f->next, i++) { ! if (new[i] != NULL) continue; if (f->sym == NULL) { --- 2121,2134 ---- if (a == actual) na = i; ! new_arg[i++] = a; } /* Make sure missing actual arguments are optional. */ i = 0; for (f = formal; f; f = f->next, i++) { ! if (new_arg[i] != NULL) continue; if (f->sym == NULL) { *************** compare_actual_formal (gfc_actual_arglis *** 2126,2152 **** argument list with null arguments in the right places. The head of the list remains the head. */ for (i = 0; i < n; i++) ! if (new[i] == NULL) ! new[i] = gfc_get_actual_arglist (); if (na != 0) { ! temp = *new[0]; ! *new[0] = *actual; *actual = temp; ! a = new[0]; ! new[0] = new[na]; ! new[na] = a; } for (i = 0; i < n - 1; i++) ! new[i]->next = new[i + 1]; ! new[i]->next = NULL; if (*ap == NULL && n > 0) ! *ap = new[0]; /* Note the types of omitted optional arguments. */ for (a = *ap, f = formal; a; a = a->next, f = f->next) --- 2150,2176 ---- argument list with null arguments in the right places. The head of the list remains the head. */ for (i = 0; i < n; i++) ! if (new_arg[i] == NULL) ! new_arg[i] = gfc_get_actual_arglist (); if (na != 0) { ! temp = *new_arg[0]; ! *new_arg[0] = *actual; *actual = temp; ! a = new_arg[0]; ! new_arg[0] = new_arg[na]; ! new_arg[na] = a; } for (i = 0; i < n - 1; i++) ! new_arg[i]->next = new_arg[i + 1]; ! new_arg[i]->next = NULL; if (*ap == NULL && n > 0) ! *ap = new_arg[0]; /* Note the types of omitted optional arguments. */ for (a = *ap, f = formal; a; a = a->next, f = f->next) *************** pair_cmp (const void *p1, const void *p2 *** 2202,2208 **** refer to the same expression. The analysis is conservative. Returning FAILURE will produce no warning. */ ! static try compare_actual_expr (gfc_expr *e1, gfc_expr *e2) { const gfc_ref *r1, *r2; --- 2226,2232 ---- refer to the same expression. The analysis is conservative. Returning FAILURE will produce no warning. */ ! static gfc_try compare_actual_expr (gfc_expr *e1, gfc_expr *e2) { const gfc_ref *r1, *r2; *************** compare_actual_expr (gfc_expr *e1, gfc_e *** 2251,2257 **** another, check that identical actual arguments aren't not associated with some incompatible INTENTs. */ ! static try check_some_aliasing (gfc_formal_arglist *f, gfc_actual_arglist *a) { sym_intent f1_intent, f2_intent; --- 2275,2281 ---- another, check that identical actual arguments aren't not associated with some incompatible INTENTs. */ ! static gfc_try check_some_aliasing (gfc_formal_arglist *f, gfc_actual_arglist *a) { sym_intent f1_intent, f2_intent; *************** check_some_aliasing (gfc_formal_arglist *** 2259,2265 **** gfc_actual_arglist *a1; size_t n, i, j; argpair *p; ! try t = SUCCESS; n = 0; for (f1 = f, a1 = a;; f1 = f1->next, a1 = a1->next) --- 2283,2289 ---- gfc_actual_arglist *a1; size_t n, i, j; argpair *p; ! gfc_try t = SUCCESS; n = 0; for (f1 = f, a1 = a;; f1 = f1->next, a1 = a1->next) *************** compare_parameter_intent (gfc_symbol *fo *** 2339,2345 **** another, check that they are compatible in the sense that intents are not mismatched. */ ! static try check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a) { sym_intent f_intent; --- 2363,2369 ---- another, check that they are compatible in the sense that intents are not mismatched. */ ! static gfc_try check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a) { sym_intent f_intent; *************** void *** 2396,2414 **** gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) { ! /* Warn about calls with an implicit interface. */ if (gfc_option.warn_implicit_interface ! && sym->attr.if_source == IFSRC_UNKNOWN) gfc_warning ("Procedure '%s' called with an implicit interface at %L", sym->name, where); ! if (sym->interface && sym->interface->attr.intrinsic) { gfc_intrinsic_sym *isym; ! isym = gfc_find_function (sym->interface->name); if (isym != NULL) { ! if (compare_actual_formal_intr (ap, sym->interface)) return; gfc_error ("Type/rank mismatch in argument '%s' at %L", sym->name, where); --- 2420,2441 ---- gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) { ! /* Warn about calls with an implicit interface. Special case ! for calling a ISO_C_BINDING becase c_loc and c_funloc ! are pseudo-unknown. */ if (gfc_option.warn_implicit_interface ! && sym->attr.if_source == IFSRC_UNKNOWN ! && ! sym->attr.is_iso_c) gfc_warning ("Procedure '%s' called with an implicit interface at %L", sym->name, where); ! if (sym->ts.interface && sym->ts.interface->attr.intrinsic) { gfc_intrinsic_sym *isym; ! isym = gfc_find_function (sym->ts.interface->name); if (isym != NULL) { ! if (compare_actual_formal_intr (ap, sym->ts.interface)) return; gfc_error ("Type/rank mismatch in argument '%s' at %L", sym->name, where); *************** gfc_procedure_use (gfc_symbol *sym, gfc_ *** 2416,2424 **** } } ! if (sym->attr.if_source == IFSRC_UNKNOWN ! || !compare_actual_formal (ap, sym->formal, 0, ! sym->attr.elemental, where)) return; check_intents (sym->formal, *ap); --- 2443,2466 ---- } } ! if (sym->attr.if_source == IFSRC_UNKNOWN) ! { ! gfc_actual_arglist *a; ! for (a = *ap; a; a = a->next) ! { ! /* Skip g77 keyword extensions like %VAL, %REF, %LOC. */ ! if (a->name != NULL && a->name[0] != '%') ! { ! gfc_error("Keyword argument requires explicit interface " ! "for procedure '%s' at %L", sym->name, &a->expr->where); ! break; ! } ! } ! ! return; ! } ! ! if (!compare_actual_formal (ap, sym->formal, 0, sym->attr.elemental, where)) return; check_intents (sym->formal, *ap); *************** gfc_procedure_use (gfc_symbol *sym, gfc_ *** 2427,2432 **** --- 2469,2498 ---- } + /* Try if an actual argument list matches the formal list of a symbol, + respecting the symbol's attributes like ELEMENTAL. This is used for + GENERIC resolution. */ + + bool + gfc_arglist_matches_symbol (gfc_actual_arglist** args, gfc_symbol* sym) + { + bool r; + + gcc_assert (sym->attr.flavor == FL_PROCEDURE); + + r = !sym->attr.elemental; + if (compare_actual_formal (args, sym->formal, r, !r, NULL)) + { + check_intents (sym->formal, *args); + if (gfc_option.warn_aliasing) + check_some_aliasing (sym->formal, *args); + return true; + } + + return false; + } + + /* Given an interface pointer and an actual argument list, search for a formal argument list that matches the actual. If found, returns a pointer to the symbol of the correct interface. Returns NULL if *************** gfc_symbol * *** 2436,2443 **** gfc_search_interface (gfc_interface *intr, int sub_flag, gfc_actual_arglist **ap) { - int r; - for (; intr; intr = intr->next) { if (sub_flag && intr->sym->attr.function) --- 2502,2507 ---- *************** gfc_search_interface (gfc_interface *int *** 2445,2459 **** if (!sub_flag && intr->sym->attr.subroutine) continue; ! r = !intr->sym->attr.elemental; ! ! if (compare_actual_formal (ap, intr->sym->formal, r, !r, NULL)) ! { ! check_intents (intr->sym->formal, *ap); ! if (gfc_option.warn_aliasing) ! check_some_aliasing (intr->sym->formal, *ap); ! return intr->sym; ! } } return NULL; --- 2509,2516 ---- if (!sub_flag && intr->sym->attr.subroutine) continue; ! if (gfc_arglist_matches_symbol (ap, intr->sym)) ! return intr->sym; } return NULL; *************** find_symtree0 (gfc_symtree *root, gfc_sy *** 2481,2488 **** /* Find a symtree for a symbol. */ ! static gfc_symtree * ! find_sym_in_symtree (gfc_symbol *sym) { gfc_symtree *st; gfc_namespace *ns; --- 2538,2545 ---- /* Find a symtree for a symbol. */ ! gfc_symtree * ! gfc_find_sym_in_symtree (gfc_symbol *sym) { gfc_symtree *st; gfc_namespace *ns; *************** find_sym_in_symtree (gfc_symbol *sym) *** 2514,2520 **** interface. If one is found, the expression node is replaced with the appropriate function call. */ ! try gfc_extend_expr (gfc_expr *e) { gfc_actual_arglist *actual; --- 2571,2577 ---- interface. If one is found, the expression node is replaced with the appropriate function call. */ ! gfc_try gfc_extend_expr (gfc_expr *e) { gfc_actual_arglist *actual; *************** gfc_extend_expr (gfc_expr *e) *** 2534,2540 **** actual->next->expr = e->value.op.op2; } ! i = fold_unary (e->value.op.operator); if (i == INTRINSIC_USER) { --- 2591,2597 ---- actual->next->expr = e->value.op.op2; } ! i = fold_unary (e->value.op.op); if (i == INTRINSIC_USER) { *************** gfc_extend_expr (gfc_expr *e) *** 2544,2550 **** if (uop == NULL) continue; ! sym = gfc_search_interface (uop->operator, 0, &actual); if (sym != NULL) break; } --- 2601,2607 ---- if (uop == NULL) continue; ! sym = gfc_search_interface (uop->op, 0, &actual); if (sym != NULL) break; } *************** gfc_extend_expr (gfc_expr *e) *** 2559,2606 **** { case INTRINSIC_EQ: case INTRINSIC_EQ_OS: ! sym = gfc_search_interface (ns->operator[INTRINSIC_EQ], 0, &actual); if (sym == NULL) ! sym = gfc_search_interface (ns->operator[INTRINSIC_EQ_OS], 0, &actual); break; case INTRINSIC_NE: case INTRINSIC_NE_OS: ! sym = gfc_search_interface (ns->operator[INTRINSIC_NE], 0, &actual); if (sym == NULL) ! sym = gfc_search_interface (ns->operator[INTRINSIC_NE_OS], 0, &actual); break; case INTRINSIC_GT: case INTRINSIC_GT_OS: ! sym = gfc_search_interface (ns->operator[INTRINSIC_GT], 0, &actual); if (sym == NULL) ! sym = gfc_search_interface (ns->operator[INTRINSIC_GT_OS], 0, &actual); break; case INTRINSIC_GE: case INTRINSIC_GE_OS: ! sym = gfc_search_interface (ns->operator[INTRINSIC_GE], 0, &actual); if (sym == NULL) ! sym = gfc_search_interface (ns->operator[INTRINSIC_GE_OS], 0, &actual); break; case INTRINSIC_LT: case INTRINSIC_LT_OS: ! sym = gfc_search_interface (ns->operator[INTRINSIC_LT], 0, &actual); if (sym == NULL) ! sym = gfc_search_interface (ns->operator[INTRINSIC_LT_OS], 0, &actual); break; case INTRINSIC_LE: case INTRINSIC_LE_OS: ! sym = gfc_search_interface (ns->operator[INTRINSIC_LE], 0, &actual); if (sym == NULL) ! sym = gfc_search_interface (ns->operator[INTRINSIC_LE_OS], 0, &actual); break; default: ! sym = gfc_search_interface (ns->operator[i], 0, &actual); } if (sym != NULL) --- 2616,2663 ---- { case INTRINSIC_EQ: case INTRINSIC_EQ_OS: ! sym = gfc_search_interface (ns->op[INTRINSIC_EQ], 0, &actual); if (sym == NULL) ! sym = gfc_search_interface (ns->op[INTRINSIC_EQ_OS], 0, &actual); break; case INTRINSIC_NE: case INTRINSIC_NE_OS: ! sym = gfc_search_interface (ns->op[INTRINSIC_NE], 0, &actual); if (sym == NULL) ! sym = gfc_search_interface (ns->op[INTRINSIC_NE_OS], 0, &actual); break; case INTRINSIC_GT: case INTRINSIC_GT_OS: ! sym = gfc_search_interface (ns->op[INTRINSIC_GT], 0, &actual); if (sym == NULL) ! sym = gfc_search_interface (ns->op[INTRINSIC_GT_OS], 0, &actual); break; case INTRINSIC_GE: case INTRINSIC_GE_OS: ! sym = gfc_search_interface (ns->op[INTRINSIC_GE], 0, &actual); if (sym == NULL) ! sym = gfc_search_interface (ns->op[INTRINSIC_GE_OS], 0, &actual); break; case INTRINSIC_LT: case INTRINSIC_LT_OS: ! sym = gfc_search_interface (ns->op[INTRINSIC_LT], 0, &actual); if (sym == NULL) ! sym = gfc_search_interface (ns->op[INTRINSIC_LT_OS], 0, &actual); break; case INTRINSIC_LE: case INTRINSIC_LE_OS: ! sym = gfc_search_interface (ns->op[INTRINSIC_LE], 0, &actual); if (sym == NULL) ! sym = gfc_search_interface (ns->op[INTRINSIC_LE_OS], 0, &actual); break; default: ! sym = gfc_search_interface (ns->op[i], 0, &actual); } if (sym != NULL) *************** gfc_extend_expr (gfc_expr *e) *** 2620,2626 **** /* Change the expression node to a function call. */ e->expr_type = EXPR_FUNCTION; ! e->symtree = find_sym_in_symtree (sym); e->value.function.actual = actual; e->value.function.esym = NULL; e->value.function.isym = NULL; --- 2677,2683 ---- /* Change the expression node to a function call. */ e->expr_type = EXPR_FUNCTION; ! e->symtree = gfc_find_sym_in_symtree (sym); e->value.function.actual = actual; e->value.function.esym = NULL; e->value.function.isym = NULL; *************** gfc_extend_expr (gfc_expr *e) *** 2646,2652 **** SUCCESS if the node was replaced. On FAILURE, no error is generated. */ ! try gfc_extend_assign (gfc_code *c, gfc_namespace *ns) { gfc_actual_arglist *actual; --- 2703,2709 ---- SUCCESS if the node was replaced. On FAILURE, no error is generated. */ ! gfc_try gfc_extend_assign (gfc_code *c, gfc_namespace *ns) { gfc_actual_arglist *actual; *************** gfc_extend_assign (gfc_code *c, gfc_name *** 2657,2663 **** rhs = c->expr2; /* Don't allow an intrinsic assignment to be replaced. */ ! if (lhs->ts.type != BT_DERIVED && rhs->ts.type != BT_DERIVED && (lhs->ts.type == rhs->ts.type || (gfc_numeric_ts (&lhs->ts) && gfc_numeric_ts (&rhs->ts)))) return FAILURE; --- 2714,2721 ---- rhs = c->expr2; /* Don't allow an intrinsic assignment to be replaced. */ ! if (lhs->ts.type != BT_DERIVED ! && (rhs->rank == 0 || rhs->rank == lhs->rank) && (lhs->ts.type == rhs->ts.type || (gfc_numeric_ts (&lhs->ts) && gfc_numeric_ts (&rhs->ts)))) return FAILURE; *************** gfc_extend_assign (gfc_code *c, gfc_name *** 2672,2678 **** for (; ns; ns = ns->parent) { ! sym = gfc_search_interface (ns->operator[INTRINSIC_ASSIGN], 1, &actual); if (sym != NULL) break; } --- 2730,2736 ---- for (; ns; ns = ns->parent) { ! sym = gfc_search_interface (ns->op[INTRINSIC_ASSIGN], 1, &actual); if (sym != NULL) break; } *************** gfc_extend_assign (gfc_code *c, gfc_name *** 2686,2692 **** /* Replace the assignment with the call. */ c->op = EXEC_ASSIGN_CALL; ! c->symtree = find_sym_in_symtree (sym); c->expr = NULL; c->expr2 = NULL; c->ext.actual = actual; --- 2744,2750 ---- /* Replace the assignment with the call. */ c->op = EXEC_ASSIGN_CALL; ! c->symtree = gfc_find_sym_in_symtree (sym); c->expr = NULL; c->expr2 = NULL; c->ext.actual = actual; *************** gfc_extend_assign (gfc_code *c, gfc_name *** 2699,2715 **** the given interface list. Ambiguity isn't checked yet since module procedures can be present without interfaces. */ ! static try ! check_new_interface (gfc_interface *base, gfc_symbol *new) { gfc_interface *ip; for (ip = base; ip; ip = ip->next) { ! if (ip->sym == new) { gfc_error ("Entity '%s' at %C is already present in the interface", ! new->name); return FAILURE; } } --- 2757,2773 ---- the given interface list. Ambiguity isn't checked yet since module procedures can be present without interfaces. */ ! static gfc_try ! check_new_interface (gfc_interface *base, gfc_symbol *new_sym) { gfc_interface *ip; for (ip = base; ip; ip = ip->next) { ! if (ip->sym == new_sym) { gfc_error ("Entity '%s' at %C is already present in the interface", ! new_sym->name); return FAILURE; } } *************** check_new_interface (gfc_interface *base *** 2720,2727 **** /* Add a symbol to the current interface. */ ! try ! gfc_add_interface (gfc_symbol *new) { gfc_interface **head, *intr; gfc_namespace *ns; --- 2778,2785 ---- /* Add a symbol to the current interface. */ ! gfc_try ! gfc_add_interface (gfc_symbol *new_sym) { gfc_interface **head, *intr; gfc_namespace *ns; *************** gfc_add_interface (gfc_symbol *new) *** 2739,2790 **** { case INTRINSIC_EQ: case INTRINSIC_EQ_OS: ! if (check_new_interface (ns->operator[INTRINSIC_EQ], new) == FAILURE || ! check_new_interface (ns->operator[INTRINSIC_EQ_OS], new) == FAILURE) return FAILURE; break; case INTRINSIC_NE: case INTRINSIC_NE_OS: ! if (check_new_interface (ns->operator[INTRINSIC_NE], new) == FAILURE || ! check_new_interface (ns->operator[INTRINSIC_NE_OS], new) == FAILURE) return FAILURE; break; case INTRINSIC_GT: case INTRINSIC_GT_OS: ! if (check_new_interface (ns->operator[INTRINSIC_GT], new) == FAILURE || ! check_new_interface (ns->operator[INTRINSIC_GT_OS], new) == FAILURE) return FAILURE; break; case INTRINSIC_GE: case INTRINSIC_GE_OS: ! if (check_new_interface (ns->operator[INTRINSIC_GE], new) == FAILURE || ! check_new_interface (ns->operator[INTRINSIC_GE_OS], new) == FAILURE) return FAILURE; break; case INTRINSIC_LT: case INTRINSIC_LT_OS: ! if (check_new_interface (ns->operator[INTRINSIC_LT], new) == FAILURE || ! check_new_interface (ns->operator[INTRINSIC_LT_OS], new) == FAILURE) return FAILURE; break; case INTRINSIC_LE: case INTRINSIC_LE_OS: ! if (check_new_interface (ns->operator[INTRINSIC_LE], new) == FAILURE || ! check_new_interface (ns->operator[INTRINSIC_LE_OS], new) == FAILURE) return FAILURE; break; default: ! if (check_new_interface (ns->operator[current_interface.op], new) == FAILURE) return FAILURE; } ! head = ¤t_interface.ns->operator[current_interface.op]; break; case INTERFACE_GENERIC: --- 2797,2848 ---- { case INTRINSIC_EQ: case INTRINSIC_EQ_OS: ! if (check_new_interface (ns->op[INTRINSIC_EQ], new_sym) == FAILURE || ! check_new_interface (ns->op[INTRINSIC_EQ_OS], new_sym) == FAILURE) return FAILURE; break; case INTRINSIC_NE: case INTRINSIC_NE_OS: ! if (check_new_interface (ns->op[INTRINSIC_NE], new_sym) == FAILURE || ! check_new_interface (ns->op[INTRINSIC_NE_OS], new_sym) == FAILURE) return FAILURE; break; case INTRINSIC_GT: case INTRINSIC_GT_OS: ! if (check_new_interface (ns->op[INTRINSIC_GT], new_sym) == FAILURE || ! check_new_interface (ns->op[INTRINSIC_GT_OS], new_sym) == FAILURE) return FAILURE; break; case INTRINSIC_GE: case INTRINSIC_GE_OS: ! if (check_new_interface (ns->op[INTRINSIC_GE], new_sym) == FAILURE || ! check_new_interface (ns->op[INTRINSIC_GE_OS], new_sym) == FAILURE) return FAILURE; break; case INTRINSIC_LT: case INTRINSIC_LT_OS: ! if (check_new_interface (ns->op[INTRINSIC_LT], new_sym) == FAILURE || ! check_new_interface (ns->op[INTRINSIC_LT_OS], new_sym) == FAILURE) return FAILURE; break; case INTRINSIC_LE: case INTRINSIC_LE_OS: ! if (check_new_interface (ns->op[INTRINSIC_LE], new_sym) == FAILURE || ! check_new_interface (ns->op[INTRINSIC_LE_OS], new_sym) == FAILURE) return FAILURE; break; default: ! if (check_new_interface (ns->op[current_interface.op], new_sym) == FAILURE) return FAILURE; } ! head = ¤t_interface.ns->op[current_interface.op]; break; case INTERFACE_GENERIC: *************** gfc_add_interface (gfc_symbol *new) *** 2794,2800 **** if (sym == NULL) continue; ! if (check_new_interface (sym->generic, new) == FAILURE) return FAILURE; } --- 2852,2858 ---- if (sym == NULL) continue; ! if (check_new_interface (sym->generic, new_sym) == FAILURE) return FAILURE; } *************** gfc_add_interface (gfc_symbol *new) *** 2802,2812 **** break; case INTERFACE_USER_OP: ! if (check_new_interface (current_interface.uop->operator, new) == FAILURE) return FAILURE; ! head = ¤t_interface.uop->operator; break; default: --- 2860,2870 ---- break; case INTERFACE_USER_OP: ! if (check_new_interface (current_interface.uop->op, new_sym) == FAILURE) return FAILURE; ! head = ¤t_interface.uop->op; break; default: *************** gfc_add_interface (gfc_symbol *new) *** 2814,2820 **** } intr = gfc_get_interface (); ! intr->sym = new; intr->where = gfc_current_locus; intr->next = *head; --- 2872,2878 ---- } intr = gfc_get_interface (); ! intr->sym = new_sym; intr->where = gfc_current_locus; intr->next = *head; *************** gfc_current_interface_head (void) *** 2830,2836 **** switch (current_interface.type) { case INTERFACE_INTRINSIC_OP: ! return current_interface.ns->operator[current_interface.op]; break; case INTERFACE_GENERIC: --- 2888,2894 ---- switch (current_interface.type) { case INTERFACE_INTRINSIC_OP: ! return current_interface.ns->op[current_interface.op]; break; case INTERFACE_GENERIC: *************** gfc_current_interface_head (void) *** 2838,2844 **** break; case INTERFACE_USER_OP: ! return current_interface.uop->operator; break; default: --- 2896,2902 ---- break; case INTERFACE_USER_OP: ! return current_interface.uop->op; break; default: *************** gfc_set_current_interface_head (gfc_inte *** 2853,2859 **** switch (current_interface.type) { case INTERFACE_INTRINSIC_OP: ! current_interface.ns->operator[current_interface.op] = i; break; case INTERFACE_GENERIC: --- 2911,2917 ---- switch (current_interface.type) { case INTERFACE_INTRINSIC_OP: ! current_interface.ns->op[current_interface.op] = i; break; case INTERFACE_GENERIC: *************** gfc_set_current_interface_head (gfc_inte *** 2861,2867 **** break; case INTERFACE_USER_OP: ! current_interface.uop->operator = i; break; default: --- 2919,2925 ---- break; case INTERFACE_USER_OP: ! current_interface.uop->op = i; break; default: diff -Nrcpad gcc-4.3.3/gcc/fortran/intrinsic.c gcc-4.4.0/gcc/fortran/intrinsic.c *** gcc-4.3.3/gcc/fortran/intrinsic.c Fri Nov 14 06:14:46 2008 --- gcc-4.4.0/gcc/fortran/intrinsic.c Fri Jan 9 23:47:55 2009 *************** *** 1,6 **** /* Build up a list of intrinsic subroutines and functions for the name-resolution stage. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb --- 1,6 ---- /* Build up a list of intrinsic subroutines and functions for the name-resolution stage. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb *************** const char *gfc_current_intrinsic_arg[MA *** 39,53 **** locus *gfc_current_intrinsic_where; static gfc_intrinsic_sym *functions, *subroutines, *conversion, *next_sym; static gfc_intrinsic_arg *next_arg; ! static int nfunc, nsub, nargs, nconv; static enum { SZ_NOTHING = 0, SZ_SUBS, SZ_FUNCS, SZ_CONVS } sizing; ! enum class { NO_CLASS = 0, CLASS_ELEMENTAL, CLASS_INQUIRY, CLASS_TRANSFORMATIONAL }; #define ACTUAL_NO 0 --- 39,54 ---- locus *gfc_current_intrinsic_where; static gfc_intrinsic_sym *functions, *subroutines, *conversion, *next_sym; + static gfc_intrinsic_sym *char_conversions; static gfc_intrinsic_arg *next_arg; ! static int nfunc, nsub, nargs, nconv, ncharconv; static enum { SZ_NOTHING = 0, SZ_SUBS, SZ_FUNCS, SZ_CONVS } sizing; ! enum klass { NO_CLASS = 0, CLASS_ELEMENTAL, CLASS_INQUIRY, CLASS_TRANSFORMATIONAL }; #define ACTUAL_NO 0 *************** find_conv (gfc_typespec *from, gfc_types *** 148,158 **** } /* Interface to the check functions. We break apart an argument list and call the proper check function rather than forcing each function to manipulate the argument list. */ ! static try do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg) { gfc_expr *a1, *a2, *a3, *a4, *a5; --- 149,181 ---- } + /* Given a pair of CHARACTER typespecs, find the gfc_intrinsic_sym node + that corresponds to the conversion. Returns NULL if the conversion + isn't found. */ + + static gfc_intrinsic_sym * + find_char_conv (gfc_typespec *from, gfc_typespec *to) + { + gfc_intrinsic_sym *sym; + const char *target; + int i; + + target = conv_name (from, to); + sym = char_conversions; + + for (i = 0; i < ncharconv; i++, sym++) + if (target == sym->name) + return sym; + + return NULL; + } + + /* Interface to the check functions. We break apart an argument list and call the proper check function rather than forcing each function to manipulate the argument list. */ ! static gfc_try do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg) { gfc_expr *a1, *a2, *a3, *a4, *a5; *************** do_check (gfc_intrinsic_sym *specific, g *** 220,226 **** ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT. */ static void ! add_sym (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type, int kind, int standard, gfc_check_f check, gfc_simplify_f simplify, gfc_resolve_f resolve, ...) { --- 243,249 ---- ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT. */ static void ! add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, gfc_check_f check, gfc_simplify_f simplify, gfc_resolve_f resolve, ...) { *************** add_sym (const char *name, gfc_isym_id i *** 309,317 **** 0 arguments. */ static void ! add_sym_0 (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type, int kind, int standard, ! try (*check) (void), gfc_expr *(*simplify) (void), void (*resolve) (gfc_expr *)) { --- 332,340 ---- 0 arguments. */ static void ! add_sym_0 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, ! gfc_try (*check) (void), gfc_expr *(*simplify) (void), void (*resolve) (gfc_expr *)) { *************** add_sym_0s (const char *name, gfc_isym_i *** 351,359 **** 1 arguments. */ static void ! add_sym_1 (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type, int kind, int standard, ! try (*check) (gfc_expr *), gfc_expr *(*simplify) (gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *), const char *a1, bt type1, int kind1, int optional1) --- 374,382 ---- 1 arguments. */ static void ! add_sym_1 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, ! gfc_try (*check) (gfc_expr *), gfc_expr *(*simplify) (gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *), const char *a1, bt type1, int kind1, int optional1) *************** add_sym_1 (const char *name, gfc_isym_id *** 376,383 **** 1 arguments. */ static void ! add_sym_1s (const char *name, gfc_isym_id id, enum class cl, bt type, int kind, int standard, ! try (*check) (gfc_expr *), gfc_expr *(*simplify) (gfc_expr *), void (*resolve) (gfc_code *), const char *a1, bt type1, int kind1, int optional1) --- 399,406 ---- 1 arguments. */ static void ! add_sym_1s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard, ! gfc_try (*check) (gfc_expr *), gfc_expr *(*simplify) (gfc_expr *), void (*resolve) (gfc_code *), const char *a1, bt type1, int kind1, int optional1) *************** add_sym_1s (const char *name, gfc_isym_i *** 400,408 **** function. MAX et al take 2 or more arguments. */ static void ! add_sym_1m (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type, int kind, int standard, ! try (*check) (gfc_actual_arglist *), gfc_expr *(*simplify) (gfc_expr *), void (*resolve) (gfc_expr *, gfc_actual_arglist *), const char *a1, bt type1, int kind1, int optional1, --- 423,431 ---- function. MAX et al take 2 or more arguments. */ static void ! add_sym_1m (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, ! gfc_try (*check) (gfc_actual_arglist *), gfc_expr *(*simplify) (gfc_expr *), void (*resolve) (gfc_expr *, gfc_actual_arglist *), const char *a1, bt type1, int kind1, int optional1, *************** add_sym_1m (const char *name, gfc_isym_i *** 427,435 **** 2 arguments. */ static void ! add_sym_2 (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type, int kind, int standard, ! try (*check) (gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *), const char *a1, bt type1, int kind1, int optional1, --- 450,458 ---- 2 arguments. */ static void ! add_sym_2 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, ! gfc_try (*check) (gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *), const char *a1, bt type1, int kind1, int optional1, *************** add_sym_2 (const char *name, gfc_isym_id *** 454,461 **** 2 arguments. */ static void ! add_sym_2s (const char *name, gfc_isym_id id, enum class cl, bt type, int kind, int standard, ! try (*check) (gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *), void (*resolve) (gfc_code *), const char *a1, bt type1, int kind1, int optional1, --- 477,484 ---- 2 arguments. */ static void ! add_sym_2s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard, ! gfc_try (*check) (gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *), void (*resolve) (gfc_code *), const char *a1, bt type1, int kind1, int optional1, *************** add_sym_2s (const char *name, gfc_isym_i *** 480,488 **** 3 arguments. */ static void ! add_sym_3 (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type, int kind, int standard, ! try (*check) (gfc_expr *, gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), const char *a1, bt type1, int kind1, int optional1, --- 503,511 ---- 3 arguments. */ static void ! add_sym_3 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, ! gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), const char *a1, bt type1, int kind1, int optional1, *************** add_sym_3 (const char *name, gfc_isym_id *** 509,517 **** might have to be reordered. */ static void ! add_sym_3ml (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type, int kind, int standard, ! try (*check) (gfc_actual_arglist *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), const char *a1, bt type1, int kind1, int optional1, --- 532,540 ---- might have to be reordered. */ static void ! add_sym_3ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, ! gfc_try (*check) (gfc_actual_arglist *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), const char *a1, bt type1, int kind1, int optional1, *************** add_sym_3ml (const char *name, gfc_isym_ *** 538,546 **** their argument also might have to be reordered. */ static void ! add_sym_3red (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type, int kind, int standard, ! try (*check) (gfc_actual_arglist *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), const char *a1, bt type1, int kind1, int optional1, --- 561,569 ---- their argument also might have to be reordered. */ static void ! add_sym_3red (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, ! gfc_try (*check) (gfc_actual_arglist *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), const char *a1, bt type1, int kind1, int optional1, *************** add_sym_3red (const char *name, gfc_isym *** 567,574 **** 3 arguments. */ static void ! add_sym_3s (const char *name, gfc_isym_id id, enum class cl, bt type, int kind, int standard, ! try (*check) (gfc_expr *, gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_code *), const char *a1, bt type1, int kind1, int optional1, --- 590,597 ---- 3 arguments. */ static void ! add_sym_3s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard, ! gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_code *), const char *a1, bt type1, int kind1, int optional1, *************** add_sym_3s (const char *name, gfc_isym_i *** 595,603 **** 4 arguments. */ static void ! add_sym_4 (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type, int kind, int standard, ! try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, --- 618,626 ---- 4 arguments. */ static void ! add_sym_4 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, ! gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, *************** add_sym_4 (const char *name, gfc_isym_id *** 628,635 **** 4 arguments. */ static void ! add_sym_4s (const char *name, gfc_isym_id id, enum class cl, bt type, int kind, int standard, ! try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_code *), --- 651,658 ---- 4 arguments. */ static void ! add_sym_4s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard, ! gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_code *), *************** add_sym_4s (const char *name, gfc_isym_i *** 659,666 **** 5 arguments. */ static void ! add_sym_5s (const char *name, gfc_isym_id id, enum class cl, bt type, int kind, int standard, ! try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), --- 682,689 ---- 5 arguments. */ static void ! add_sym_5s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard, ! gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), *************** gfc_intrinsic_actual_ok (const char *nam *** 784,798 **** } ! /* Given a string, figure out if it is the name of an intrinsic ! subroutine or function. There are no generic intrinsic ! subroutines, they are all specific. */ ! int ! gfc_intrinsic_name (const char *name, int subroutine_flag) { ! return subroutine_flag ? gfc_find_subroutine (name) != NULL ! : gfc_find_function (name) != NULL; } --- 807,853 ---- } ! /* Given a symbol, find out if it is (and is to be treated) an intrinsic. If ! it's name refers to an intrinsic but this intrinsic is not included in the ! selected standard, this returns FALSE and sets the symbol's external ! attribute. */ ! bool ! gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc) { ! gfc_intrinsic_sym* isym; ! const char* symstd; ! ! /* If INTRINSIC/EXTERNAL state is already known, return. */ ! if (sym->attr.intrinsic) ! return true; ! if (sym->attr.external) ! return false; ! ! if (subroutine_flag) ! isym = gfc_find_subroutine (sym->name); ! else ! isym = gfc_find_function (sym->name); ! ! /* No such intrinsic available at all? */ ! if (!isym) ! return false; ! ! /* See if this intrinsic is allowed in the current standard. */ ! if (gfc_check_intrinsic_standard (isym, &symstd, false, loc) == FAILURE) ! { ! if (gfc_option.warn_intrinsics_std) ! gfc_warning_now ("The intrinsic '%s' at %L is not included in the" ! " selected standard but %s and '%s' will be treated as" ! " if declared EXTERNAL. Use an appropriate -std=*" ! " option or define -fall-intrinsics to allow this" ! " intrinsic.", sym->name, &loc, symstd, sym->name); ! sym->attr.external = 1; ! ! return false; ! } ! ! return true; } *************** add_functions (void) *** 964,988 **** make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77); ! add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_fn_r, gfc_simplify_acosh, gfc_resolve_acosh, ! x, BT_REAL, dr, REQUIRED); add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_acosh, gfc_resolve_acosh, x, BT_REAL, dd, REQUIRED); ! make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_GNU); ! add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95, ! NULL, gfc_simplify_adjustl, NULL, ! stg, BT_CHARACTER, dc, REQUIRED); make_generic ("adjustl", GFC_ISYM_ADJUSTL, GFC_STD_F95); ! add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95, ! NULL, gfc_simplify_adjustr, NULL, ! stg, BT_CHARACTER, dc, REQUIRED); make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95); --- 1019,1043 ---- make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77); ! add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, ! GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_acosh, ! gfc_resolve_acosh, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_acosh, gfc_resolve_acosh, x, BT_REAL, dd, REQUIRED); ! make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_F2008); ! add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL, CLASS_ELEMENTAL, ACTUAL_NO, ! BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustl, ! gfc_resolve_adjustl, stg, BT_CHARACTER, 0, REQUIRED); make_generic ("adjustl", GFC_ISYM_ADJUSTL, GFC_STD_F95); ! add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR, CLASS_ELEMENTAL, ACTUAL_NO, ! BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustr, ! gfc_resolve_adjustr, stg, BT_CHARACTER, 0, REQUIRED); make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95); *************** add_functions (void) *** 1047,1061 **** make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77); ! add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_fn_r, gfc_simplify_asinh, gfc_resolve_asinh, ! x, BT_REAL, dr, REQUIRED); add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_asinh, gfc_resolve_asinh, x, BT_REAL, dd, REQUIRED); ! make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_GNU); add_sym_2 ("associated", GFC_ISYM_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95, gfc_check_associated, NULL, NULL, --- 1102,1116 ---- make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77); ! add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, ! GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_asinh, ! gfc_resolve_asinh, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_asinh, gfc_resolve_asinh, x, BT_REAL, dd, REQUIRED); ! make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_F2008); add_sym_2 ("associated", GFC_ISYM_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95, gfc_check_associated, NULL, NULL, *************** add_functions (void) *** 1073,1087 **** make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77); ! add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_fn_r, gfc_simplify_atanh, gfc_resolve_atanh, ! x, BT_REAL, dr, REQUIRED); add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_atanh, gfc_resolve_atanh, x, BT_REAL, dd, REQUIRED); ! make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_GNU); add_sym_2 ("atan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77, gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2, --- 1128,1142 ---- make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77); ! add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, ! GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_atanh, ! gfc_resolve_atanh, x, BT_REAL, dr, REQUIRED); add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_atanh, gfc_resolve_atanh, x, BT_REAL, dd, REQUIRED); ! make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_F2008); add_sym_2 ("atan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77, gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2, *************** add_functions (void) *** 1095,1158 **** /* Bessel and Neumann functions for G77 compatibility. */ add_sym_1 ("besj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_fn_r, NULL, gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dbesj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU, ! gfc_check_fn_d, NULL, gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED); ! make_generic ("besj0", GFC_ISYM_J0, GFC_STD_GNU); add_sym_1 ("besj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_fn_r, NULL, gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dbesj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU, ! gfc_check_fn_d, NULL, gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED); ! make_generic ("besj1", GFC_ISYM_J1, GFC_STD_GNU); add_sym_2 ("besjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_besn, NULL, gfc_resolve_besn, n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED); add_sym_2 ("dbesjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU, ! gfc_check_besn, NULL, gfc_resolve_besn, n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED); ! make_generic ("besjn", GFC_ISYM_JN, GFC_STD_GNU); add_sym_1 ("besy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_fn_r, NULL, gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dbesy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU, ! gfc_check_fn_d, NULL, gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED); ! make_generic ("besy0", GFC_ISYM_Y0, GFC_STD_GNU); add_sym_1 ("besy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_fn_r, NULL, gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dbesy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU, ! gfc_check_fn_d, NULL, gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED); ! make_generic ("besy1", GFC_ISYM_Y1, GFC_STD_GNU); add_sym_2 ("besyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_besn, NULL, gfc_resolve_besn, n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED); add_sym_2 ("dbesyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU, ! gfc_check_besn, NULL, gfc_resolve_besn, n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED); ! make_generic ("besyn", GFC_ISYM_YN, GFC_STD_GNU); add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95, gfc_check_i, gfc_simplify_bit_size, NULL, --- 1150,1225 ---- /* Bessel and Neumann functions for G77 compatibility. */ add_sym_1 ("besj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_fn_r, gfc_simplify_bessel_j0, gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED); + make_alias ("bessel_j0", GFC_STD_F2008); + add_sym_1 ("dbesj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU, ! gfc_check_fn_d, gfc_simplify_bessel_j0, gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED); ! make_generic ("bessel_j0", GFC_ISYM_J0, GFC_STD_F2008); add_sym_1 ("besj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_fn_r, gfc_simplify_bessel_j1, gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED); + make_alias ("bessel_j1", GFC_STD_F2008); + add_sym_1 ("dbesj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU, ! gfc_check_fn_d, gfc_simplify_bessel_j1, gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED); ! make_generic ("bessel_j1", GFC_ISYM_J1, GFC_STD_F2008); add_sym_2 ("besjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn, n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED); + make_alias ("bessel_jn", GFC_STD_F2008); + add_sym_2 ("dbesjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU, ! gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn, n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED); ! make_generic ("bessel_jn", GFC_ISYM_JN, GFC_STD_F2008); add_sym_1 ("besy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_fn_r, gfc_simplify_bessel_y0, gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED); + make_alias ("bessel_y0", GFC_STD_F2008); + add_sym_1 ("dbesy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU, ! gfc_check_fn_d, gfc_simplify_bessel_y0, gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED); ! make_generic ("bessel_y0", GFC_ISYM_Y0, GFC_STD_F2008); add_sym_1 ("besy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_fn_r, gfc_simplify_bessel_y1, gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED); + make_alias ("bessel_y1", GFC_STD_F2008); + add_sym_1 ("dbesy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU, ! gfc_check_fn_d, gfc_simplify_bessel_y1, gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED); ! make_generic ("bessel_y1", GFC_ISYM_Y1, GFC_STD_F2008); add_sym_2 ("besyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn, n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED); + make_alias ("bessel_yn", GFC_STD_F2008); + add_sym_2 ("dbesyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU, ! gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn, n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED); ! make_generic ("bessel_yn", GFC_ISYM_YN, GFC_STD_F2008); add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95, gfc_check_i, gfc_simplify_bit_size, NULL, *************** add_functions (void) *** 1339,1363 **** make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95); /* G77 compatibility for the ERF() and ERFC() functions. */ ! add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_fn_r, NULL, gfc_resolve_g77_math1, ! x, BT_REAL, dr, REQUIRED); ! add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU, ! gfc_check_fn_d, NULL, gfc_resolve_g77_math1, ! x, BT_REAL, dd, REQUIRED); ! make_generic ("erf", GFC_ISYM_ERF, GFC_STD_GNU); ! add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_fn_r, NULL, gfc_resolve_g77_math1, ! x, BT_REAL, dr, REQUIRED); ! add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU, ! gfc_check_fn_d, NULL, gfc_resolve_g77_math1, ! x, BT_REAL, dd, REQUIRED); ! make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_GNU); /* G77 compatibility */ add_sym_1 ("dtime", GFC_ISYM_DTIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU, --- 1406,1436 ---- make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95); /* G77 compatibility for the ERF() and ERFC() functions. */ ! add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, ! GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erf, ! gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED); ! add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, ! GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erf, ! gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED); ! make_generic ("erf", GFC_ISYM_ERF, GFC_STD_F2008); ! add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, ! GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erfc, ! gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED); ! add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, ! GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erfc, ! gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED); ! make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_F2008); ! ! add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED, CLASS_ELEMENTAL, ACTUAL_NO, ! BT_REAL, dr, GFC_STD_F2008, gfc_check_fn_r, NULL, ! gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED); ! ! make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED, GFC_STD_F2008); /* G77 compatibility */ add_sym_1 ("dtime", GFC_ISYM_DTIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU, *************** add_functions (void) *** 1458,1472 **** make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU); ! add_sym_1 ("gamma", GFC_ISYM_GAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, ! gfc_check_fn_r, gfc_simplify_gamma, gfc_resolve_gamma, ! x, BT_REAL, dr, REQUIRED); add_sym_1 ("dgamma", GFC_ISYM_GAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_gamma, gfc_resolve_gamma, x, BT_REAL, dr, REQUIRED); ! make_generic ("gamma", GFC_ISYM_GAMMA, GFC_STD_GNU); /* Unix IDs (g77 compatibility) */ add_sym_1 ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU, --- 1531,1545 ---- make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU); ! add_sym_1 ("gamma", GFC_ISYM_GAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, ! GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_gamma, ! gfc_resolve_gamma, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dgamma", GFC_ISYM_GAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_gamma, gfc_resolve_gamma, x, BT_REAL, dr, REQUIRED); ! make_generic ("gamma", GFC_ISYM_GAMMA, GFC_STD_F2008); /* Unix IDs (g77 compatibility) */ add_sym_1 ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU, *************** add_functions (void) *** 1502,1507 **** --- 1575,1587 ---- make_generic ("huge", GFC_ISYM_HUGE, GFC_STD_F95); + add_sym_2 ("hypot", GFC_ISYM_HYPOT, CLASS_ELEMENTAL, ACTUAL_NO, + BT_REAL, dr, GFC_STD_F2008, + gfc_check_hypot, gfc_simplify_hypot, gfc_resolve_hypot, + x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED); + + make_generic ("hypot", GFC_ISYM_HYPOT, GFC_STD_F2008); + add_sym_2 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95, gfc_check_ichar_iachar, gfc_simplify_iachar, gfc_resolve_iachar, *************** add_functions (void) *** 1701,1706 **** --- 1781,1793 ---- make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95); + add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO, + BT_INTEGER, di, GFC_STD_F2008, + gfc_check_i, gfc_simplify_leadz, NULL, + i, BT_INTEGER, di, REQUIRED); + + make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008); + add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77, gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len, *************** add_functions (void) *** 1717,1726 **** make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95); ! add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma, x, BT_REAL, dr, REQUIRED); add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma, x, BT_REAL, dr, REQUIRED); --- 1804,1816 ---- make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95); ! add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, ! dr, GFC_STD_GNU, gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma, x, BT_REAL, dr, REQUIRED); + make_alias ("log_gamma", GFC_STD_F2008); + add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU, gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma, x, BT_REAL, dr, REQUIRED); *************** add_functions (void) *** 1729,1757 **** gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma, x, BT_REAL, dr, REQUIRED); ! make_generic ("lgamma", GFC_ISYM_LGAMMA, GFC_STD_GNU); ! add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F77, ! NULL, gfc_simplify_lge, NULL, sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED); make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77); ! add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F77, ! NULL, gfc_simplify_lgt, NULL, sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED); make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77); ! add_sym_2 ("lle",GFC_ISYM_LLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F77, ! NULL, gfc_simplify_lle, NULL, sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED); make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77); ! add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F77, ! NULL, gfc_simplify_llt, NULL, sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED); make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77); --- 1819,1847 ---- gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma, x, BT_REAL, dr, REQUIRED); ! make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008); ! add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, ! GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lge, NULL, sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED); make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77); ! add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, ! GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lgt, NULL, sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED); make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77); ! add_sym_2 ("lle",GFC_ISYM_LLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, ! GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lle, NULL, sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED); make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77); ! add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, ! GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_llt, NULL, sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED); make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77); *************** add_functions (void) *** 1884,1890 **** make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU); add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95, ! gfc_check_merge, NULL, gfc_resolve_merge, ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED); --- 1974,1980 ---- make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU); add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95, ! gfc_check_merge, gfc_simplify_merge, gfc_resolve_merge, ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED); *************** add_functions (void) *** 2113,2118 **** --- 2203,2215 ---- make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU); + add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL, + ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003, + gfc_check_selected_char_kind, gfc_simplify_selected_char_kind, + NULL, nm, BT_CHARACTER, dc, REQUIRED); + + make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003); + add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95, gfc_check_selected_int_kind, gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED); *************** add_functions (void) *** 2199,2207 **** add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU, gfc_check_sizeof, NULL, NULL, ! i, BT_UNKNOWN, 0, REQUIRED); make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU); add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95, gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing, --- 2296,2305 ---- add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU, gfc_check_sizeof, NULL, NULL, ! x, BT_UNKNOWN, 0, REQUIRED); make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU); + make_alias ("c_sizeof", GFC_STD_F2008); add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95, gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing, *************** add_functions (void) *** 2297,2302 **** --- 2395,2407 ---- make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95); + add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO, + BT_INTEGER, di, GFC_STD_F2008, + gfc_check_i, gfc_simplify_trailz, NULL, + i, BT_INTEGER, di, REQUIRED); + + make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008); + add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95, gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer, src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED, *************** add_subroutines (void) *** 2543,2549 **** add_sym_1s ("flush", GFC_ISYM_FLUSH, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_flush, NULL, gfc_resolve_flush, ! c, BT_INTEGER, di, OPTIONAL); add_sym_3s ("fputc", GFC_ISYM_FPUTC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub, --- 2648,2654 ---- add_sym_1s ("flush", GFC_ISYM_FLUSH, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_flush, NULL, gfc_resolve_flush, ! ut, BT_INTEGER, di, OPTIONAL); add_sym_3s ("fputc", GFC_ISYM_FPUTC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub, *************** add_subroutines (void) *** 2590,2596 **** add_sym_1s ("sleep", GFC_ISYM_SLEEP, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub, ! val, BT_CHARACTER, dc, REQUIRED); add_sym_3s ("fstat", GFC_ISYM_FSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub, --- 2695,2701 ---- add_sym_1s ("sleep", GFC_ISYM_SLEEP, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub, ! val, BT_INTEGER, di, REQUIRED); add_sym_3s ("fstat", GFC_ISYM_FSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub, *************** add_subroutines (void) *** 2619,2625 **** add_sym_2s ("system", GFC_ISYM_SYSTEM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, NULL, NULL, gfc_resolve_system_sub, ! c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL); add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_system_clock, NULL, gfc_resolve_system_clock, --- 2724,2730 ---- add_sym_2s ("system", GFC_ISYM_SYSTEM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, NULL, NULL, gfc_resolve_system_sub, ! com, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL); add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_system_clock, NULL, gfc_resolve_system_clock, *************** add_conversions (void) *** 2782,2787 **** --- 2887,2938 ---- } + static void + add_char_conversions (void) + { + int n, i, j; + + /* Count possible conversions. */ + for (i = 0; gfc_character_kinds[i].kind != 0; i++) + for (j = 0; gfc_character_kinds[j].kind != 0; j++) + if (i != j) + ncharconv++; + + /* Allocate memory. */ + char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv); + + /* Add the conversions themselves. */ + n = 0; + for (i = 0; gfc_character_kinds[i].kind != 0; i++) + for (j = 0; gfc_character_kinds[j].kind != 0; j++) + { + gfc_typespec from, to; + + if (i == j) + continue; + + gfc_clear_ts (&from); + from.type = BT_CHARACTER; + from.kind = gfc_character_kinds[i].kind; + + gfc_clear_ts (&to); + to.type = BT_CHARACTER; + to.kind = gfc_character_kinds[j].kind; + + char_conversions[n].name = conv_name (&from, &to); + char_conversions[n].lib_name = char_conversions[n].name; + char_conversions[n].simplify.cc = gfc_convert_char_constant; + char_conversions[n].standard = GFC_STD_F2003; + char_conversions[n].elemental = 1; + char_conversions[n].conversion = 0; + char_conversions[n].ts = to; + char_conversions[n].id = GFC_ISYM_CONVERSION; + + n++; + } + } + + /* Initialize the table of intrinsics. */ void gfc_intrinsic_init_1 (void) *************** gfc_intrinsic_init_1 (void) *** 2800,2812 **** sizing = SZ_CONVS; add_conversions (); ! functions = gfc_getmem (sizeof (gfc_intrinsic_sym) * (nfunc + nsub) ! + sizeof (gfc_intrinsic_arg) * nargs); next_sym = functions; subroutines = functions + nfunc; ! conversion = gfc_getmem (sizeof (gfc_intrinsic_sym) * nconv); next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1; --- 2951,2964 ---- sizing = SZ_CONVS; add_conversions (); ! functions = XCNEWVAR (struct gfc_intrinsic_sym, ! sizeof (gfc_intrinsic_sym) * (nfunc + nsub) ! + sizeof (gfc_intrinsic_arg) * nargs); next_sym = functions; subroutines = functions + nfunc; ! conversion = XCNEWVEC (gfc_intrinsic_sym, nconv); next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1; *************** gfc_intrinsic_init_1 (void) *** 2817,2822 **** --- 2969,2977 ---- add_subroutines (); add_conversions (); + /* Character conversion intrinsics need to be treated separately. */ + add_char_conversions (); + /* Set the pure flag. All intrinsic functions are pure, and intrinsic subroutines are pure if they are elemental. */ *************** gfc_intrinsic_done_1 (void) *** 2833,2838 **** --- 2988,2994 ---- { gfc_free (functions); gfc_free (conversion); + gfc_free (char_conversions); gfc_free_namespace (gfc_intrinsic_namespace); } *************** remove_nullargs (gfc_actual_arglist **ap *** 2882,2888 **** wrong (say, a missing required argument) we abort sorting and return FAILURE. */ ! static try sort_actual (const char *name, gfc_actual_arglist **ap, gfc_intrinsic_arg *formal, locus *where) { --- 3038,3044 ---- wrong (say, a missing required argument) we abort sorting and return FAILURE. */ ! static gfc_try sort_actual (const char *name, gfc_actual_arglist **ap, gfc_intrinsic_arg *formal, locus *where) { *************** do_sort: *** 3003,3009 **** list. The lists are checked for agreement of type. We don't check for arrayness here. */ ! static try check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym, int error_flag) { --- 3159,3165 ---- list. The lists are checked for agreement of type. We don't check for arrayness here. */ ! static gfc_try check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym, int error_flag) { *************** check_arglist (gfc_actual_arglist **ap, *** 3017,3026 **** i = 0; for (; formal; formal = formal->next, actual = actual->next, i++) { if (actual->expr == NULL) continue; ! if (!gfc_compare_types (&formal->ts, &actual->expr->ts)) { if (error_flag) gfc_error ("Type of argument '%s' in call to '%s' at %L should " --- 3173,3190 ---- i = 0; for (; formal; formal = formal->next, actual = actual->next, i++) { + gfc_typespec ts; + if (actual->expr == NULL) continue; ! ts = formal->ts; ! ! /* A kind of 0 means we don't check for kind. */ ! if (ts.kind == 0) ! ts.kind = actual->expr->ts.kind; ! ! if (!gfc_compare_types (&ts, &actual->expr->ts)) { if (error_flag) gfc_error ("Type of argument '%s' in call to '%s' at %L should " *************** resolve_intrinsic (gfc_intrinsic_sym *sp *** 3127,3133 **** of the simplification, SUCCESS if the simplification worked, even if nothing has changed in the expression itself. */ ! static try do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e) { gfc_expr *result, *a1, *a2, *a3, *a4, *a5; --- 3291,3297 ---- of the simplification, SUCCESS if the simplification worked, even if nothing has changed in the expression itself. */ ! static gfc_try do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e) { gfc_expr *result, *a1, *a2, *a3, *a4, *a5; *************** do_simplify (gfc_intrinsic_sym *specific *** 3164,3178 **** a1 = arg->expr; arg = arg->next; ! if (specific->simplify.cc == gfc_convert_constant) { ! result = gfc_convert_constant (a1, specific->ts.type, specific->ts.kind); goto finish; } - /* TODO: Warn if -pedantic and initialization expression and arg - types not integer or character */ - if (arg == NULL) result = (*specific->simplify.f1) (a1); else --- 3328,3340 ---- a1 = arg->expr; arg = arg->next; ! if (specific->simplify.cc == gfc_convert_constant ! || specific->simplify.cc == gfc_convert_char_constant) { ! result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind); goto finish; } if (arg == NULL) result = (*specific->simplify.f1) (a1); else *************** init_arglist (gfc_intrinsic_sym *isym) *** 3255,3265 **** intrinsic's formal argument list. Return SUCCESS if the expression and intrinsic match, FAILURE otherwise. */ ! static try check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag) { gfc_actual_arglist *arg, **ap; ! try t; ap = &expr->value.function.actual; --- 3417,3427 ---- intrinsic's formal argument list. Return SUCCESS if the expression and intrinsic match, FAILURE otherwise. */ ! static gfc_try check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag) { gfc_actual_arglist *arg, **ap; ! gfc_try t; ap = &expr->value.function.actual; *************** check_specific (gfc_intrinsic_sym *speci *** 3329,3349 **** /* Check whether an intrinsic belongs to whatever standard the user ! has chosen. */ ! static try ! check_intrinsic_standard (const char *name, int standard, locus *where) { ! /* Do not warn about GNU-extensions if -std=gnu. */ ! if (!gfc_option.warn_nonstd_intrinsics ! || (standard == GFC_STD_GNU && gfc_option.warn_std & GFC_STD_GNU)) return SUCCESS; ! if (gfc_notify_std (standard, "Intrinsic '%s' at %L is not included " ! "in the selected standard", name, where) == FAILURE) ! return FAILURE; ! return SUCCESS; } --- 3491,3572 ---- /* Check whether an intrinsic belongs to whatever standard the user ! has chosen, taking also into account -fall-intrinsics. Here, no ! warning/error is emitted; but if symstd is not NULL, it is pointed to a ! textual representation of the symbols standard status (like ! "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that ! can be used to construct a detailed warning/error message in case of ! a FAILURE. */ ! gfc_try ! gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym, ! const char** symstd, bool silent, locus where) { ! const char* symstd_msg; ! ! /* For -fall-intrinsics, just succeed. */ ! if (gfc_option.flag_all_intrinsics) return SUCCESS; ! /* Find the symbol's standard message for later usage. */ ! switch (isym->standard) ! { ! case GFC_STD_F77: ! symstd_msg = "available since Fortran 77"; ! break; ! case GFC_STD_F95_OBS: ! symstd_msg = "obsolescent in Fortran 95"; ! break; ! ! case GFC_STD_F95_DEL: ! symstd_msg = "deleted in Fortran 95"; ! break; ! ! case GFC_STD_F95: ! symstd_msg = "new in Fortran 95"; ! break; ! ! case GFC_STD_F2003: ! symstd_msg = "new in Fortran 2003"; ! break; ! ! case GFC_STD_F2008: ! symstd_msg = "new in Fortran 2008"; ! break; ! ! case GFC_STD_GNU: ! symstd_msg = "a GNU Fortran extension"; ! break; ! ! case GFC_STD_LEGACY: ! symstd_msg = "for backward compatibility"; ! break; ! ! default: ! gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)", ! isym->name, isym->standard); ! } ! ! /* If warning about the standard, warn and succeed. */ ! if (gfc_option.warn_std & isym->standard) ! { ! /* Do only print a warning if not a GNU extension. */ ! if (!silent && isym->standard != GFC_STD_GNU) ! gfc_warning ("Intrinsic '%s' (is %s) is used at %L", ! isym->name, _(symstd_msg), &where); ! ! return SUCCESS; ! } ! ! /* If allowing the symbol's standard, succeed, too. */ ! if (gfc_option.allow_std & isym->standard) ! return SUCCESS; ! ! /* Otherwise, fail. */ ! if (symstd) ! *symstd = _(symstd_msg); ! return FAILURE; } *************** gfc_intrinsic_func_interface (gfc_expr * *** 3372,3378 **** return (do_simplify (expr->value.function.isym, expr) == FAILURE) ? MATCH_ERROR : MATCH_YES; ! gfc_suppress_error = !error_flag; flag = 0; for (actual = expr->value.function.actual; actual; actual = actual->next) --- 3595,3602 ---- return (do_simplify (expr->value.function.isym, expr) == FAILURE) ? MATCH_ERROR : MATCH_YES; ! if (!error_flag) ! gfc_push_suppress_errors (); flag = 0; for (actual = expr->value.function.actual; actual; actual = actual->next) *************** gfc_intrinsic_func_interface (gfc_expr * *** 3385,3404 **** isym = specific = gfc_find_function (name); if (isym == NULL) { ! gfc_suppress_error = 0; return MATCH_NO; } - if (check_intrinsic_standard (name, isym->standard, &expr->where) == FAILURE) - return MATCH_ERROR; - if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE || isym->id == GFC_ISYM_CMPLX) && gfc_init_expr && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' " "as initialization expression at %L", name, &expr->where) == FAILURE) ! return MATCH_ERROR; gfc_current_intrinsic_where = &expr->where; --- 3609,3630 ---- isym = specific = gfc_find_function (name); if (isym == NULL) { ! if (!error_flag) ! gfc_pop_suppress_errors (); return MATCH_NO; } if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE || isym->id == GFC_ISYM_CMPLX) && gfc_init_expr && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' " "as initialization expression at %L", name, &expr->where) == FAILURE) ! { ! if (!error_flag) ! gfc_pop_suppress_errors (); ! return MATCH_ERROR; ! } gfc_current_intrinsic_where = &expr->where; *************** gfc_intrinsic_func_interface (gfc_expr * *** 3410,3416 **** if (gfc_check_min_max (expr->value.function.actual) == SUCCESS) goto got_specific; ! gfc_suppress_error = 0; return MATCH_NO; } --- 3636,3643 ---- if (gfc_check_min_max (expr->value.function.actual) == SUCCESS) goto got_specific; ! if (!error_flag) ! gfc_pop_suppress_errors (); return MATCH_NO; } *************** gfc_intrinsic_func_interface (gfc_expr * *** 3418,3424 **** incarnations. If the generic name is also a specific, we check that name last, so that any error message will correspond to the specific. */ ! gfc_suppress_error = 1; if (isym->generic) { --- 3645,3651 ---- incarnations. If the generic name is also a specific, we check that name last, so that any error message will correspond to the specific. */ ! gfc_push_suppress_errors (); if (isym->generic) { *************** gfc_intrinsic_func_interface (gfc_expr * *** 3428,3442 **** if (specific == isym) continue; if (check_specific (specific, expr, 0) == SUCCESS) ! goto got_specific; } } ! gfc_suppress_error = !error_flag; if (check_specific (isym, expr, error_flag) == FAILURE) { ! gfc_suppress_error = 0; return MATCH_NO; } --- 3655,3673 ---- if (specific == isym) continue; if (check_specific (specific, expr, 0) == SUCCESS) ! { ! gfc_pop_suppress_errors (); ! goto got_specific; ! } } } ! gfc_pop_suppress_errors (); if (check_specific (isym, expr, error_flag) == FAILURE) { ! if (!error_flag) ! gfc_pop_suppress_errors (); return MATCH_NO; } *************** got_specific: *** 3446,3452 **** expr->value.function.isym = specific; gfc_intrinsic_symbol (expr->symtree->n.sym); ! gfc_suppress_error = 0; if (do_simplify (specific, expr) == FAILURE) return MATCH_ERROR; --- 3677,3685 ---- expr->value.function.isym = specific; gfc_intrinsic_symbol (expr->symtree->n.sym); ! if (!error_flag) ! gfc_pop_suppress_errors (); ! if (do_simplify (specific, expr) == FAILURE) return MATCH_ERROR; *************** gfc_intrinsic_sub_interface (gfc_code *c *** 3486,3495 **** if (isym == NULL) return MATCH_NO; ! if (check_intrinsic_standard (name, isym->standard, &c->loc) == FAILURE) ! return MATCH_ERROR; ! ! gfc_suppress_error = !error_flag; init_arglist (isym); --- 3719,3726 ---- if (isym == NULL) return MATCH_NO; ! if (!error_flag) ! gfc_push_suppress_errors (); init_arglist (isym); *************** gfc_intrinsic_sub_interface (gfc_code *c *** 3509,3516 **** /* The subroutine corresponds to an intrinsic. Allow errors to be seen at this point. */ ! gfc_suppress_error = 0; if (isym->resolve.s1 != NULL) isym->resolve.s1 (c); else --- 3740,3749 ---- /* The subroutine corresponds to an intrinsic. Allow errors to be seen at this point. */ ! if (!error_flag) ! gfc_pop_suppress_errors (); + c->resolved_isym = isym; if (isym->resolve.s1 != NULL) isym->resolve.s1 (c); else *************** gfc_intrinsic_sub_interface (gfc_code *c *** 3531,3544 **** return MATCH_YES; fail: ! gfc_suppress_error = 0; return MATCH_NO; } /* Call gfc_convert_type() with warning enabled. */ ! try gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag) { return gfc_convert_type_warn (expr, ts, eflag, 1); --- 3764,3778 ---- return MATCH_YES; fail: ! if (!error_flag) ! gfc_pop_suppress_errors (); return MATCH_NO; } /* Call gfc_convert_type() with warning enabled. */ ! gfc_try gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag) { return gfc_convert_type_warn (expr, ts, eflag, 1); *************** gfc_convert_type (gfc_expr *expr, gfc_ty *** 3555,3567 **** 'wflag' controls the warning related to conversion. */ ! try gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag) { gfc_intrinsic_sym *sym; gfc_typespec from_ts; locus old_where; ! gfc_expr *new; int rank; mpz_t *shape; --- 3789,3801 ---- 'wflag' controls the warning related to conversion. */ ! gfc_try gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag) { gfc_intrinsic_sym *sym; gfc_typespec from_ts; locus old_where; ! gfc_expr *new_expr; int rank; mpz_t *shape; *************** gfc_convert_type_warn (gfc_expr *expr, g *** 3603,3631 **** rank = expr->rank; shape = expr->shape; ! new = gfc_get_expr (); ! *new = *expr; ! new = gfc_build_conversion (new); ! new->value.function.name = sym->lib_name; ! new->value.function.isym = sym; ! new->where = old_where; ! new->rank = rank; ! new->shape = gfc_copy_shape (shape, rank); ! gfc_get_ha_sym_tree (sym->name, &new->symtree); ! new->symtree->n.sym->ts = *ts; ! new->symtree->n.sym->attr.flavor = FL_PROCEDURE; ! new->symtree->n.sym->attr.function = 1; ! new->symtree->n.sym->attr.elemental = 1; ! new->symtree->n.sym->attr.pure = 1; ! new->symtree->n.sym->attr.referenced = 1; ! gfc_intrinsic_symbol(new->symtree->n.sym); ! gfc_commit_symbol (new->symtree->n.sym); ! *expr = *new; ! gfc_free (new); expr->ts = *ts; if (gfc_is_constant_expr (expr->value.function.actual->expr) --- 3837,3865 ---- rank = expr->rank; shape = expr->shape; ! new_expr = gfc_get_expr (); ! *new_expr = *expr; ! new_expr = gfc_build_conversion (new_expr); ! new_expr->value.function.name = sym->lib_name; ! new_expr->value.function.isym = sym; ! new_expr->where = old_where; ! 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->attr.flavor = FL_PROCEDURE; ! new_expr->symtree->n.sym->attr.function = 1; ! new_expr->symtree->n.sym->attr.elemental = 1; ! new_expr->symtree->n.sym->attr.pure = 1; ! new_expr->symtree->n.sym->attr.referenced = 1; ! gfc_intrinsic_symbol(new_expr->symtree->n.sym); ! gfc_commit_symbol (new_expr->symtree->n.sym); ! *expr = *new_expr; ! gfc_free (new_expr); expr->ts = *ts; if (gfc_is_constant_expr (expr->value.function.actual->expr) *************** bad: *** 3652,3654 **** --- 3886,3983 ---- &expr->where); /* Not reached */ } + + + gfc_try + gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts) + { + gfc_intrinsic_sym *sym; + gfc_typespec from_ts; + locus old_where; + gfc_expr *new_expr; + int rank; + mpz_t *shape; + + gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER); + from_ts = expr->ts; /* expr->ts gets clobbered */ + + sym = find_char_conv (&expr->ts, ts); + gcc_assert (sym); + + /* Insert a pre-resolved function call to the right function. */ + old_where = expr->where; + rank = expr->rank; + shape = expr->shape; + + new_expr = gfc_get_expr (); + *new_expr = *expr; + + new_expr = gfc_build_conversion (new_expr); + new_expr->value.function.name = sym->lib_name; + new_expr->value.function.isym = sym; + new_expr->where = old_where; + 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->attr.flavor = FL_PROCEDURE; + new_expr->symtree->n.sym->attr.function = 1; + new_expr->symtree->n.sym->attr.elemental = 1; + new_expr->symtree->n.sym->attr.referenced = 1; + gfc_intrinsic_symbol(new_expr->symtree->n.sym); + gfc_commit_symbol (new_expr->symtree->n.sym); + + *expr = *new_expr; + + gfc_free (new_expr); + expr->ts = *ts; + + if (gfc_is_constant_expr (expr->value.function.actual->expr) + && do_simplify (sym, expr) == FAILURE) + { + /* Error already generated in do_simplify() */ + return FAILURE; + } + + return SUCCESS; + } + + + /* Check if the passed name is name of an intrinsic (taking into account the + current -std=* and -fall-intrinsic settings). If it is, see if we should + warn about this as a user-procedure having the same name as an intrinsic + (-Wintrinsic-shadow enabled) and do so if we should. */ + + void + gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func) + { + gfc_intrinsic_sym* isym; + + /* If the warning is disabled, do nothing at all. */ + if (!gfc_option.warn_intrinsic_shadow) + return; + + /* Try to find an intrinsic of the same name. */ + if (func) + isym = gfc_find_function (sym->name); + else + isym = gfc_find_subroutine (sym->name); + + /* If no intrinsic was found with this name or it's not included in the + selected standard, everything's fine. */ + if (!isym || gfc_check_intrinsic_standard (isym, NULL, true, + sym->declared_at) == FAILURE) + return; + + /* Emit the warning. */ + if (in_module) + gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same" + " name. In order to call the intrinsic, explicit INTRINSIC" + " declarations may be required.", + sym->name, &sym->declared_at); + else + gfc_warning ("'%s' declared at %L is also the name of an intrinsic. It can" + " only be called via an explicit interface or if declared" + " EXTERNAL.", sym->name, &sym->declared_at); + } diff -Nrcpad gcc-4.3.3/gcc/fortran/intrinsic.h gcc-4.4.0/gcc/fortran/intrinsic.h *** gcc-4.3.3/gcc/fortran/intrinsic.h Fri Nov 14 06:14:46 2008 --- gcc-4.4.0/gcc/fortran/intrinsic.h Fri Jan 9 23:47:55 2009 *************** *** 1,6 **** /* Header file for intrinsics check, resolve and simplify function prototypes. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb --- 1,6 ---- /* Header file for intrinsics check, resolve and simplify function prototypes. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb *************** extern gfc_expr gfc_bad_expr; *** 26,191 **** /* Check functions. */ ! try gfc_check_a_ikind (gfc_expr *, gfc_expr *); ! try gfc_check_a_xkind (gfc_expr *, gfc_expr *); ! try gfc_check_a_p (gfc_expr *, gfc_expr *); ! try gfc_check_x_yd (gfc_expr *, gfc_expr *); ! try gfc_check_abs (gfc_expr *); ! try gfc_check_access_func (gfc_expr *, gfc_expr *); ! try gfc_check_achar (gfc_expr *, gfc_expr *); ! try gfc_check_all_any (gfc_expr *, gfc_expr *); ! try gfc_check_allocated (gfc_expr *); ! try gfc_check_associated (gfc_expr *, gfc_expr *); ! try gfc_check_atan2 (gfc_expr *, gfc_expr *); ! try gfc_check_besn (gfc_expr *, gfc_expr *); ! try gfc_check_btest (gfc_expr *, gfc_expr *); ! try gfc_check_char (gfc_expr *, gfc_expr *); ! try gfc_check_chdir (gfc_expr *); ! try gfc_check_chmod (gfc_expr *, gfc_expr *); ! try gfc_check_cmplx (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_complex (gfc_expr *, gfc_expr *); ! try gfc_check_count (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_ctime (gfc_expr *); ! try gfc_check_datan2 (gfc_expr *, gfc_expr *); ! try gfc_check_dcmplx (gfc_expr *, gfc_expr *); ! try gfc_check_dble (gfc_expr *); ! try gfc_check_digits (gfc_expr *); ! try gfc_check_dot_product (gfc_expr *, gfc_expr *); ! try gfc_check_dprod (gfc_expr *, gfc_expr *); ! try gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_dtime_etime (gfc_expr *); ! try gfc_check_fgetputc (gfc_expr *, gfc_expr *); ! try gfc_check_fgetput (gfc_expr *); ! try gfc_check_fstat (gfc_expr *, gfc_expr *); ! try gfc_check_ftell (gfc_expr *); ! try gfc_check_fn_c (gfc_expr *); ! try gfc_check_fn_d (gfc_expr *); ! try gfc_check_fn_r (gfc_expr *); ! try gfc_check_fn_rc (gfc_expr *); ! try gfc_check_fnum (gfc_expr *); ! try gfc_check_hostnm (gfc_expr *); ! try gfc_check_huge (gfc_expr *); ! try gfc_check_i (gfc_expr *); ! try gfc_check_iand (gfc_expr *, gfc_expr *); ! try gfc_check_and (gfc_expr *, gfc_expr *); ! try gfc_check_ibclr (gfc_expr *, gfc_expr *); ! try gfc_check_ibits (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_ibset (gfc_expr *, gfc_expr *); ! try gfc_check_ichar_iachar (gfc_expr *, gfc_expr *); ! try gfc_check_idnint (gfc_expr *); ! try gfc_check_ieor (gfc_expr *, gfc_expr *); ! try gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_int (gfc_expr *, gfc_expr *); ! try gfc_check_intconv (gfc_expr *); ! try gfc_check_ior (gfc_expr *, gfc_expr *); ! try gfc_check_irand (gfc_expr *); ! try gfc_check_isatty (gfc_expr *); ! try gfc_check_isnan (gfc_expr *); ! try gfc_check_ishft (gfc_expr *, gfc_expr *); ! try gfc_check_ishftc (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_kill (gfc_expr *, gfc_expr *); ! try gfc_check_kind (gfc_expr *); ! try gfc_check_lbound (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_len_lentrim (gfc_expr *, gfc_expr *); ! try gfc_check_link (gfc_expr *, gfc_expr *); ! try gfc_check_loc (gfc_expr *); ! try gfc_check_logical (gfc_expr *, gfc_expr *); ! try gfc_check_min_max (gfc_actual_arglist *); ! try gfc_check_min_max_integer (gfc_actual_arglist *); ! try gfc_check_min_max_real (gfc_actual_arglist *); ! try gfc_check_min_max_double (gfc_actual_arglist *); ! try gfc_check_malloc (gfc_expr *); ! try gfc_check_matmul (gfc_expr *, gfc_expr *); ! try gfc_check_merge (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_minloc_maxloc (gfc_actual_arglist *); ! try gfc_check_minval_maxval (gfc_actual_arglist *); ! try gfc_check_nearest (gfc_expr *, gfc_expr *); ! try gfc_check_new_line (gfc_expr *); ! try gfc_check_null (gfc_expr *); ! try gfc_check_pack (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_precision (gfc_expr *); ! try gfc_check_present (gfc_expr *); ! try gfc_check_product_sum (gfc_actual_arglist *); ! try gfc_check_radix (gfc_expr *); ! try gfc_check_rand (gfc_expr *); ! try gfc_check_range (gfc_expr *); ! try gfc_check_real (gfc_expr *, gfc_expr *); ! try gfc_check_rename (gfc_expr *, gfc_expr *); ! try gfc_check_repeat (gfc_expr *, gfc_expr *); ! try gfc_check_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_scale (gfc_expr *, gfc_expr *); ! try gfc_check_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_second_sub (gfc_expr *); ! try gfc_check_secnds (gfc_expr *); ! try gfc_check_selected_int_kind (gfc_expr *); ! try gfc_check_selected_real_kind (gfc_expr *, gfc_expr *); ! try gfc_check_set_exponent (gfc_expr *, gfc_expr *); ! try gfc_check_shape (gfc_expr *); ! try gfc_check_size (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_sign (gfc_expr *, gfc_expr *); ! try gfc_check_signal (gfc_expr *, gfc_expr *); ! try gfc_check_sizeof (gfc_expr *); ! try gfc_check_spread (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_srand (gfc_expr *); ! try gfc_check_stat (gfc_expr *, gfc_expr *); ! try gfc_check_sum (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_symlnk (gfc_expr *, gfc_expr *); ! try gfc_check_transfer (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_transpose (gfc_expr *); ! try gfc_check_trim (gfc_expr *); ! try gfc_check_ttynam (gfc_expr *); ! try gfc_check_ubound (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_umask (gfc_expr *); ! try gfc_check_unlink (gfc_expr *); ! try gfc_check_unpack (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_x (gfc_expr *); /* Intrinsic subroutines. */ ! try gfc_check_alarm_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_chdir_sub (gfc_expr *, gfc_expr *); ! try gfc_check_chmod_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_cpu_time (gfc_expr *); ! try gfc_check_ctime_sub (gfc_expr *, gfc_expr *); ! try gfc_check_system_clock (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_date_and_time (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_exit (gfc_expr *); ! try gfc_check_fdate_sub (gfc_expr *); ! try gfc_check_flush (gfc_expr *); ! try gfc_check_free (gfc_expr *); ! try gfc_check_fstat_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_gerror (gfc_expr *); ! try gfc_check_getarg (gfc_expr *, gfc_expr *); ! try gfc_check_getlog (gfc_expr *); ! try gfc_check_move_alloc (gfc_expr *, gfc_expr *); ! try gfc_check_mvbits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_random_number (gfc_expr *); ! try gfc_check_random_seed (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_dtime_etime_sub (gfc_expr *, gfc_expr *); ! try gfc_check_fgetputc_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_fgetput_sub (gfc_expr *, gfc_expr *); ! try gfc_check_fseek_sub (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_ftell_sub (gfc_expr *, gfc_expr *); ! try gfc_check_getcwd_sub (gfc_expr *, gfc_expr *); ! try gfc_check_hostnm_sub (gfc_expr *, gfc_expr *); ! try gfc_check_itime_idate (gfc_expr *); ! try gfc_check_kill_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_ltime_gmtime (gfc_expr *, gfc_expr *); ! try gfc_check_perror (gfc_expr *); ! try gfc_check_rename_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_link_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_symlnk_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_signal_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_sleep_sub (gfc_expr *); ! try gfc_check_stat_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! try gfc_check_system_sub (gfc_expr *, gfc_expr *); ! try gfc_check_ttynam_sub (gfc_expr *, gfc_expr *); ! try gfc_check_umask_sub (gfc_expr *, gfc_expr *); ! try gfc_check_unlink_sub (gfc_expr *, gfc_expr *); /* Simplification functions. */ --- 26,194 ---- /* Check functions. */ ! gfc_try gfc_check_a_ikind (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_a_xkind (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_a_p (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_x_yd (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_abs (gfc_expr *); ! gfc_try gfc_check_access_func (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_achar (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_all_any (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_allocated (gfc_expr *); ! gfc_try gfc_check_associated (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_atan2 (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_besn (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_btest (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_char (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_chdir (gfc_expr *); ! gfc_try gfc_check_chmod (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_cmplx (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_complex (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_count (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_ctime (gfc_expr *); ! gfc_try gfc_check_datan2 (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_dcmplx (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_dble (gfc_expr *); ! gfc_try gfc_check_digits (gfc_expr *); ! gfc_try gfc_check_dot_product (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_dprod (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_dtime_etime (gfc_expr *); ! gfc_try gfc_check_fgetputc (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_fgetput (gfc_expr *); ! gfc_try gfc_check_fstat (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_ftell (gfc_expr *); ! gfc_try gfc_check_fn_c (gfc_expr *); ! gfc_try gfc_check_fn_d (gfc_expr *); ! gfc_try gfc_check_fn_r (gfc_expr *); ! gfc_try gfc_check_fn_rc (gfc_expr *); ! gfc_try gfc_check_fnum (gfc_expr *); ! gfc_try gfc_check_hostnm (gfc_expr *); ! gfc_try gfc_check_huge (gfc_expr *); ! gfc_try gfc_check_hypot (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_i (gfc_expr *); ! gfc_try gfc_check_iand (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_and (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_ibclr (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_ibits (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_ibset (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_ichar_iachar (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_idnint (gfc_expr *); ! gfc_try gfc_check_ieor (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_int (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_intconv (gfc_expr *); ! gfc_try gfc_check_ior (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_irand (gfc_expr *); ! gfc_try gfc_check_isatty (gfc_expr *); ! gfc_try gfc_check_isnan (gfc_expr *); ! gfc_try gfc_check_ishft (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_ishftc (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_kill (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_kind (gfc_expr *); ! gfc_try gfc_check_lbound (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_len_lentrim (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_link (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_lge_lgt_lle_llt (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_loc (gfc_expr *); ! gfc_try gfc_check_logical (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_min_max (gfc_actual_arglist *); ! gfc_try gfc_check_min_max_integer (gfc_actual_arglist *); ! gfc_try gfc_check_min_max_real (gfc_actual_arglist *); ! gfc_try gfc_check_min_max_double (gfc_actual_arglist *); ! gfc_try gfc_check_malloc (gfc_expr *); ! gfc_try gfc_check_matmul (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_merge (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_minloc_maxloc (gfc_actual_arglist *); ! gfc_try gfc_check_minval_maxval (gfc_actual_arglist *); ! gfc_try gfc_check_nearest (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_new_line (gfc_expr *); ! gfc_try gfc_check_null (gfc_expr *); ! gfc_try gfc_check_pack (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_precision (gfc_expr *); ! gfc_try gfc_check_present (gfc_expr *); ! gfc_try gfc_check_product_sum (gfc_actual_arglist *); ! gfc_try gfc_check_radix (gfc_expr *); ! gfc_try gfc_check_rand (gfc_expr *); ! gfc_try gfc_check_range (gfc_expr *); ! gfc_try gfc_check_real (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_rename (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_repeat (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_scale (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_second_sub (gfc_expr *); ! gfc_try gfc_check_secnds (gfc_expr *); ! gfc_try gfc_check_selected_char_kind (gfc_expr *); ! gfc_try gfc_check_selected_int_kind (gfc_expr *); ! gfc_try gfc_check_selected_real_kind (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_set_exponent (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_shape (gfc_expr *); ! gfc_try gfc_check_size (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_sign (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_signal (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_sizeof (gfc_expr *); ! gfc_try gfc_check_spread (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_srand (gfc_expr *); ! gfc_try gfc_check_stat (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_sum (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_symlnk (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_transfer (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_transpose (gfc_expr *); ! gfc_try gfc_check_trim (gfc_expr *); ! gfc_try gfc_check_ttynam (gfc_expr *); ! gfc_try gfc_check_ubound (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_umask (gfc_expr *); ! gfc_try gfc_check_unlink (gfc_expr *); ! gfc_try gfc_check_unpack (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_x (gfc_expr *); /* Intrinsic subroutines. */ ! gfc_try gfc_check_alarm_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_chdir_sub (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_chmod_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_cpu_time (gfc_expr *); ! gfc_try gfc_check_ctime_sub (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_system_clock (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_date_and_time (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_exit (gfc_expr *); ! gfc_try gfc_check_fdate_sub (gfc_expr *); ! gfc_try gfc_check_flush (gfc_expr *); ! gfc_try gfc_check_free (gfc_expr *); ! gfc_try gfc_check_fstat_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_gerror (gfc_expr *); ! gfc_try gfc_check_getarg (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_getlog (gfc_expr *); ! gfc_try gfc_check_move_alloc (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_mvbits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_random_number (gfc_expr *); ! gfc_try gfc_check_random_seed (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_dtime_etime_sub (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_fgetputc_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_fgetput_sub (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_fseek_sub (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_ftell_sub (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_getcwd_sub (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_hostnm_sub (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_itime_idate (gfc_expr *); ! gfc_try gfc_check_kill_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_ltime_gmtime (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_perror (gfc_expr *); ! gfc_try gfc_check_rename_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_link_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_symlnk_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_signal_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_sleep_sub (gfc_expr *); ! gfc_try gfc_check_stat_sub (gfc_expr *, gfc_expr *, gfc_expr *); ! gfc_try gfc_check_system_sub (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_ttynam_sub (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_umask_sub (gfc_expr *, gfc_expr *); ! gfc_try gfc_check_unlink_sub (gfc_expr *, gfc_expr *); /* Simplification functions. */ *************** gfc_expr *gfc_simplify_asinh (gfc_expr * *** 206,211 **** --- 209,220 ---- 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_bessel_j0 (gfc_expr *); + gfc_expr *gfc_simplify_bessel_j1 (gfc_expr *); + gfc_expr *gfc_simplify_bessel_jn (gfc_expr *, gfc_expr *); + gfc_expr *gfc_simplify_bessel_y0 (gfc_expr *); + gfc_expr *gfc_simplify_bessel_y1 (gfc_expr *); + gfc_expr *gfc_simplify_bessel_yn (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_bit_size (gfc_expr *); gfc_expr *gfc_simplify_btest (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_ceiling (gfc_expr *, gfc_expr *); *************** gfc_expr *gfc_simplify_digits (gfc_expr *** 221,226 **** --- 230,237 ---- gfc_expr *gfc_simplify_dim (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_dprod (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_epsilon (gfc_expr *); + gfc_expr *gfc_simplify_erf (gfc_expr *); + gfc_expr *gfc_simplify_erfc (gfc_expr *); gfc_expr *gfc_simplify_exp (gfc_expr *); gfc_expr *gfc_simplify_exponent (gfc_expr *); gfc_expr *gfc_simplify_float (gfc_expr *); *************** gfc_expr *gfc_simplify_floor (gfc_expr * *** 228,233 **** --- 239,245 ---- gfc_expr *gfc_simplify_fraction (gfc_expr *); gfc_expr *gfc_simplify_gamma (gfc_expr *); gfc_expr *gfc_simplify_huge (gfc_expr *); + gfc_expr *gfc_simplify_hypot (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_iachar (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_iand (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_ibclr (gfc_expr *, gfc_expr *); *************** gfc_expr *gfc_simplify_ishft (gfc_expr * *** 247,252 **** --- 259,265 ---- gfc_expr *gfc_simplify_ishftc (gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_kind (gfc_expr *); gfc_expr *gfc_simplify_lbound (gfc_expr *, gfc_expr *, gfc_expr *); + gfc_expr *gfc_simplify_leadz (gfc_expr *); gfc_expr *gfc_simplify_len (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_len_trim (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_lgamma (gfc_expr *); *************** gfc_expr *gfc_simplify_llt (gfc_expr *, *** 257,262 **** --- 270,276 ---- gfc_expr *gfc_simplify_log (gfc_expr *); gfc_expr *gfc_simplify_log10 (gfc_expr *); gfc_expr *gfc_simplify_logical (gfc_expr *, gfc_expr *); + gfc_expr *gfc_simplify_merge (gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_min (gfc_expr *); gfc_expr *gfc_simplify_minval (gfc_expr *, gfc_expr*, gfc_expr*); gfc_expr *gfc_simplify_max (gfc_expr *); *************** gfc_expr *gfc_simplify_reshape (gfc_expr *** 285,290 **** --- 299,305 ---- gfc_expr *gfc_simplify_rrspacing (gfc_expr *); gfc_expr *gfc_simplify_scale (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); + gfc_expr *gfc_simplify_selected_char_kind (gfc_expr *); gfc_expr *gfc_simplify_selected_int_kind (gfc_expr *); gfc_expr *gfc_simplify_selected_real_kind (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_set_exponent (gfc_expr *, gfc_expr *); *************** gfc_expr *gfc_simplify_sqrt (gfc_expr *) *** 299,304 **** --- 314,320 ---- gfc_expr *gfc_simplify_tan (gfc_expr *); gfc_expr *gfc_simplify_tanh (gfc_expr *); 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_trim (gfc_expr *); gfc_expr *gfc_simplify_ubound (gfc_expr *, gfc_expr *, gfc_expr *); *************** gfc_expr *gfc_simplify_xor (gfc_expr *, *** 307,317 **** --- 323,336 ---- /* Constant conversion simplification. */ gfc_expr *gfc_convert_constant (gfc_expr *, bt, int); + gfc_expr *gfc_convert_char_constant (gfc_expr *, bt, int); /* Resolution functions. */ void gfc_resolve_abs (gfc_expr *, gfc_expr *); void gfc_resolve_access (gfc_expr *, gfc_expr *, gfc_expr *); + void gfc_resolve_adjustl (gfc_expr *, gfc_expr *); + void gfc_resolve_adjustr (gfc_expr *, gfc_expr *); void gfc_resolve_achar (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_acos (gfc_expr *, gfc_expr *); void gfc_resolve_acosh (gfc_expr *, gfc_expr *); *************** void gfc_resolve_getgid (gfc_expr *); *** 370,375 **** --- 389,395 ---- void gfc_resolve_getpid (gfc_expr *); void gfc_resolve_getuid (gfc_expr *); void gfc_resolve_hostnm (gfc_expr *, gfc_expr *); + void gfc_resolve_hypot (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_iand (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ibclr (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ibits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); diff -Nrcpad gcc-4.3.3/gcc/fortran/intrinsic.texi gcc-4.4.0/gcc/fortran/intrinsic.texi *** gcc-4.3.3/gcc/fortran/intrinsic.texi Fri Feb 15 22:56:37 2008 --- gcc-4.4.0/gcc/fortran/intrinsic.texi Fri Feb 20 15:20:38 2009 *************** *** 1,5 **** @ignore ! Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc. This is part of the GNU Fortran manual. For copying conditions, see the file gfortran.texi. --- 1,5 ---- @ignore ! Copyright (C) 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. This is part of the GNU Fortran manual. For copying conditions, see the file gfortran.texi. *************** For copying conditions, see the file gfo *** 7,16 **** Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.2 or any later version published by the Free Software Foundation; with the ! Invariant Sections being ``GNU General Public License'' and ``Funding ! Free Software'', the Front-Cover texts being (a) (see below), and with ! the Back-Cover Texts being (b) (see below). A copy of the license is ! included in the gfdl(7) man page. Some basic guidelines for editing this document: --- 7,15 ---- Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.2 or any later version published by the Free Software Foundation; with the ! Invariant Sections being ``Funding Free Software'', the Front-Cover ! Texts being (a) (see below), and with the Back-Cover Texts being (b) ! (see below). A copy of the license is included in the gfdl(7) man page. Some basic guidelines for editing this document: *************** Some basic guidelines for editing this d *** 62,73 **** * @code{ATAN}: ATAN, Arctangent function * @code{ATAN2}: ATAN2, Arctangent function * @code{ATANH}: ATANH, Hyperbolic arctangent function ! * @code{BESJ0}: BESJ0, Bessel function of the first kind of order 0 ! * @code{BESJ1}: BESJ1, Bessel function of the first kind of order 1 ! * @code{BESJN}: BESJN, Bessel function of the first kind ! * @code{BESY0}: BESY0, Bessel function of the second kind of order 0 ! * @code{BESY1}: BESY1, Bessel function of the second kind of order 1 ! * @code{BESYN}: BESYN, Bessel function of the second kind * @code{BIT_SIZE}: BIT_SIZE, Bit size inquiry function * @code{BTEST}: BTEST, Bit test function * @code{C_ASSOCIATED}: C_ASSOCIATED, Status of a C pointer --- 61,72 ---- * @code{ATAN}: ATAN, Arctangent function * @code{ATAN2}: ATAN2, Arctangent function * @code{ATANH}: ATANH, Hyperbolic arctangent function ! * @code{BESSEL_J0}: BESSEL_J0, Bessel function of the first kind of order 0 ! * @code{BESSEL_J1}: BESSEL_J1, Bessel function of the first kind of order 1 ! * @code{BESSEL_JN}: BESSEL_JN, Bessel function of the first kind ! * @code{BESSEL_Y0}: BESSEL_Y0, Bessel function of the second kind of order 0 ! * @code{BESSEL_Y1}: BESSEL_Y1, Bessel function of the second kind of order 1 ! * @code{BESSEL_YN}: BESSEL_YN, Bessel function of the second kind * @code{BIT_SIZE}: BIT_SIZE, Bit size inquiry function * @code{BTEST}: BTEST, Bit test function * @code{C_ASSOCIATED}: C_ASSOCIATED, Status of a C pointer *************** Some basic guidelines for editing this d *** 75,80 **** --- 74,80 ---- * @code{C_F_PROCPOINTER}: C_F_PROCPOINTER, Convert C into Fortran procedure pointer * @code{C_FUNLOC}: C_FUNLOC, Obtain the C address of a procedure * @code{C_LOC}: C_LOC, Obtain the C address of an object + * @code{C_SIZEOF}: C_SIZEOF, Size in bytes of an expression * @code{CEILING}: CEILING, Integer ceiling function * @code{CHAR}: CHAR, Integer-to-character conversion function * @code{CHDIR}: CHDIR, Change working directory *************** Some basic guidelines for editing this d *** 103,108 **** --- 103,109 ---- * @code{EPSILON}: EPSILON, Epsilon function * @code{ERF}: ERF, Error function * @code{ERFC}: ERFC, Complementary error function + * @code{ERFC_SCALED}: ERFC_SCALED, Exponentially-scaled complementary error function * @code{ETIME}: ETIME, Execution time subroutine (or function) * @code{EXIT}: EXIT, Exit the program with status. * @code{EXP}: EXP, Exponential function *************** Some basic guidelines for editing this d *** 136,141 **** --- 137,143 ---- * @code{GMTIME}: GMTIME, Convert time to GMT info * @code{HOSTNM}: HOSTNM, Get system host name * @code{HUGE}: HUGE, Largest number of a kind + * @code{HYPOT}: HYPOT, Euclidian distance function * @code{IACHAR}: IACHAR, Code in @acronym{ASCII} collating sequence * @code{IAND}: IAND, Bitwise logical and * @code{IARGC}: IARGC, Get the number of command line arguments *************** Some basic guidelines for editing this d *** 162,170 **** * @code{KILL}: KILL, Send a signal to a process * @code{KIND}: KIND, Kind of an entity * @code{LBOUND}: LBOUND, Lower dimension bounds of an array * @code{LEN}: LEN, Length of a character entity * @code{LEN_TRIM}: LEN_TRIM, Length of a character entity without trailing blank characters ! * @code{LGAMMA}: LGAMMA, Logarithm of the Gamma function * @code{LGE}: LGE, Lexical greater than or equal * @code{LGT}: LGT, Lexical greater than * @code{LINK}: LINK, Create a hard link --- 164,173 ---- * @code{KILL}: KILL, Send a signal to a process * @code{KIND}: KIND, Kind of an entity * @code{LBOUND}: LBOUND, Lower dimension bounds of an array + * @code{LEADZ}: LEADZ, Number of leading zero bits of an integer * @code{LEN}: LEN, Length of a character entity * @code{LEN_TRIM}: LEN_TRIM, Length of a character entity without trailing blank characters ! * @code{LOG_GAMMA}: LOG_GAMMA, Logarithm of the Gamma function * @code{LGE}: LGE, Lexical greater than or equal * @code{LGT}: LGT, Lexical greater than * @code{LINK}: LINK, Create a hard link *************** Some basic guidelines for editing this d *** 211,217 **** * @code{RANDOM_NUMBER}: RANDOM_NUMBER, Pseudo-random number * @code{RANDOM_SEED}: RANDOM_SEED, Initialize a pseudo-random number sequence * @code{RAND}: RAND, Real pseudo-random number ! * @code{RANGE}: RANGE, Decimal exponent range of a real kind * @code{RAN}: RAN, Real pseudo-random number * @code{REAL}: REAL, Convert to real type * @code{RENAME}: RENAME, Rename a file --- 214,220 ---- * @code{RANDOM_NUMBER}: RANDOM_NUMBER, Pseudo-random number * @code{RANDOM_SEED}: RANDOM_SEED, Initialize a pseudo-random number sequence * @code{RAND}: RAND, Real pseudo-random number ! * @code{RANGE}: RANGE, Decimal exponent range * @code{RAN}: RAN, Real pseudo-random number * @code{REAL}: REAL, Convert to real type * @code{RENAME}: RENAME, Rename a file *************** Some basic guidelines for editing this d *** 223,228 **** --- 226,232 ---- * @code{SCAN}: SCAN, Scan a string for the presence of a set of characters * @code{SECNDS}: SECNDS, Time function * @code{SECOND}: SECOND, CPU time function + * @code{SELECTED_CHAR_KIND}: SELECTED_CHAR_KIND, Choose character kind * @code{SELECTED_INT_KIND}: SELECTED_INT_KIND, Choose integer kind * @code{SELECTED_REAL_KIND}: SELECTED_REAL_KIND, Choose real kind * @code{SET_EXPONENT}: SET_EXPONENT, Set the exponent of the model *************** Some basic guidelines for editing this d *** 249,254 **** --- 253,259 ---- * @code{TIME}: TIME, Time function * @code{TIME8}: TIME8, Time function (64-bit) * @code{TINY}: TINY, Smallest positive number of a real kind + * @code{TRAILZ}: TRAILZ, Number of trailing zero bits of an integer * @code{TRANSFER}: TRANSFER, Transfer bit patterns * @code{TRANSPOSE}: TRANSPOSE, Transpose an array of rank two * @code{TRIM}: TRIM, Remove trailing blank characters of a string *************** Some basic guidelines for editing this d *** 266,276 **** The intrinsic procedures provided by GNU Fortran include all of the intrinsic procedures required by the Fortran 95 standard, a set of ! intrinsic procedures for backwards compatibility with G77, and a small ! selection of intrinsic procedures from the Fortran 2003 standard. Any ! conflict between a description here and a description in either the ! Fortran 95 standard or the Fortran 2003 standard is unintentional, and ! the standard(s) should be considered authoritative. The enumeration of the @code{KIND} type parameter is processor defined in the Fortran 95 standard. GNU Fortran defines the default integer type and --- 271,282 ---- The intrinsic procedures provided by GNU Fortran include all of the intrinsic procedures required by the Fortran 95 standard, a set of ! intrinsic procedures for backwards compatibility with G77, and a ! selection of intrinsic procedures from the Fortran 2003 and Fortran 2008 ! standards. Any conflict between a description here and a description in ! either the Fortran 95 standard, the Fortran 2003 standard or the Fortran ! 2008 standard is unintentional, and the standard(s) should be considered ! authoritative. The enumeration of the @code{KIND} type parameter is processor defined in the Fortran 95 standard. GNU Fortran defines the default integer type and *************** the applicable standard for each intrins *** 312,319 **** @table @asis @item @emph{Description}: @code{ABORT} causes immediate termination of the program. On operating ! systems that support a core dump, @code{ABORT} will produce a core dump, ! which is suitable for debugging purposes. @item @emph{Standard}: GNU extension --- 318,327 ---- @table @asis @item @emph{Description}: @code{ABORT} causes immediate termination of the program. On operating ! systems that support a core dump, @code{ABORT} will produce a core dump even if ! the option @option{-fno-dump-core} is in effect, which is suitable for debugging ! purposes. ! @c TODO: Check if this (with -fno-dump-core) is correct. @item @emph{Standard}: GNU extension *************** end program test_abort *** 354,380 **** @table @asis @item @emph{Description}: ! @code{ABS(X)} computes the absolute value of @code{X}. @item @emph{Standard}: ! F77 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = ABS(X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type of the argument shall be an @code{INTEGER(*)}, ! @code{REAL(*)}, or @code{COMPLEX(*)}. @end multitable @item @emph{Return value}: The return value is of the same type and ! kind as the argument except the return value is @code{REAL(*)} for a ! @code{COMPLEX(*)} argument. @item @emph{Example}: @smallexample --- 362,388 ---- @table @asis @item @emph{Description}: ! @code{ABS(A)} computes the absolute value of @code{A}. @item @emph{Standard}: ! Fortran 77 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = ABS(A)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A} @tab The type of the argument shall be an @code{INTEGER}, ! @code{REAL}, or @code{COMPLEX}. @end multitable @item @emph{Return value}: The return value is of the same type and ! kind as the argument except the return value is @code{REAL} for a ! @code{COMPLEX} argument. @item @emph{Example}: @smallexample *************** end program test_abs *** 391,401 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{CABS(Z)} @tab @code{COMPLEX(4) Z} @tab @code{REAL(4)} @tab F77 and later ! @item @code{DABS(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab F77 and later ! @item @code{IABS(I)} @tab @code{INTEGER(4) I} @tab @code{INTEGER(4)} @tab F77 and later ! @item @code{ZABS(Z)} @tab @code{COMPLEX(8) Z} @tab @code{COMPLEX(8)} @tab GNU extension ! @item @code{CDABS(Z)} @tab @code{COMPLEX(8) Z} @tab @code{COMPLEX(8)} @tab GNU extension @end multitable @end table --- 399,409 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{CABS(A)} @tab @code{COMPLEX(4) Z} @tab @code{REAL(4)} @tab Fortran 77 and later ! @item @code{DABS(A)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later ! @item @code{IABS(A)} @tab @code{INTEGER(4) I} @tab @code{INTEGER(4)} @tab Fortran 77 and later ! @item @code{ZABS(A)} @tab @code{COMPLEX(8) Z} @tab @code{COMPLEX(8)} @tab GNU extension ! @item @code{CDABS(A)} @tab @code{COMPLEX(8) Z} @tab @code{COMPLEX(8)} @tab GNU extension @end multitable @end table *************** Inquiry function *** 424,436 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{NAME} @tab Scalar @code{CHARACTER} with the file name. ! Tailing blank are ignored unless the character @code{achar(0)} is ! present, then all characters up to and excluding @code{achar(0)} are used as file name. ! @item @var{MODE} @tab Scalar @code{CHARACTER} with the file access mode, ! may be any concatenation of @code{"r"} (readable), @code{"w"} (writable) ! and @code{"x"} (executable), or @code{" "} to check for existence. @end multitable @item @emph{Return value}: --- 432,445 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{NAME} @tab Scalar @code{CHARACTER} of default kind with the ! file name. Tailing blank are ignored unless the character @code{achar(0)} ! is present, then all characters up to and excluding @code{achar(0)} are used as file name. ! @item @var{MODE} @tab Scalar @code{CHARACTER} of default kind with the ! file access mode, may be any concatenation of @code{"r"} (readable), ! @code{"w"} (writable) and @code{"x"} (executable), or @code{" "} to check ! for existence. @end multitable @item @emph{Return value}: *************** end program access_test *** 471,492 **** in the @acronym{ASCII} collating sequence. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = ACHAR(I)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER(*)}. @end multitable @item @emph{Return value}: ! The return value is of type @code{CHARACTER} with a length of one. The ! kind type parameter is the same as @code{KIND('A')}. @item @emph{Example}: @smallexample --- 480,504 ---- in the @acronym{ASCII} collating sequence. @item @emph{Standard}: ! Fortran 77 and later, with @var{KIND} argument Fortran 2003 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = ACHAR(I [, KIND])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: ! The return value is of type @code{CHARACTER} with a length of one. ! If the @var{KIND} argument is present, the return value is of the ! specified kind and of the default kind otherwise. @item @emph{Example}: @smallexample *************** and formatted string representations. *** 519,525 **** @code{ACOS(X)} computes the arccosine of @var{X} (inverse of @code{COS(X)}). @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 531,537 ---- @code{ACOS(X)} computes the arccosine of @var{X} (inverse of @code{COS(X)}). @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 529,542 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)} with a magnitude that is ! less than one. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL(*)} and it lies in the ! range @math{ 0 \leq \acos(x) \leq \pi}. The kind type parameter ! is the same as @var{X}. @item @emph{Example}: @smallexample --- 541,554 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL} with a magnitude that is ! less than or equal to one. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL} and it lies in the ! range @math{ 0 \leq \acos(x) \leq \pi}. The return value if of the same ! kind as @var{X}. @item @emph{Example}: @smallexample *************** end program test_acos *** 549,555 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DACOS(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab F77 and later @end multitable @item @emph{See also}: --- 561,567 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DACOS(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @end multitable @item @emph{See also}: *************** Inverse function: @ref{COS} *** 574,580 **** @code{COSH(X)}). @item @emph{Standard}: ! GNU extension @item @emph{Class}: Elemental function --- 586,592 ---- @code{COSH(X)}). @item @emph{Standard}: ! Fortran 2008 and later @item @emph{Class}: Elemental function *************** Elemental function *** 584,596 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)} with a magnitude that is ! greater or equal to one. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL(*)} and it lies in the ! range @math{0 \leq \acosh (x) \leq \infty}. @item @emph{Example}: @smallexample --- 596,606 ---- @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 the same type and kind as @var{X} @item @emph{Example}: @smallexample *************** Inverse function: @ref{COSH} *** 620,646 **** @table @asis @item @emph{Description}: ! @code{ADJUSTL(STR)} will left adjust a string by removing leading spaces. Spaces are inserted at the end of the string as needed. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = ADJUSTL(STR)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STR} @tab The type shall be @code{CHARACTER}. @end multitable @item @emph{Return value}: ! The return value is of type @code{CHARACTER} where leading spaces ! are removed and the same number of spaces are inserted on the end ! of @var{STR}. @item @emph{Example}: @smallexample --- 630,656 ---- @table @asis @item @emph{Description}: ! @code{ADJUSTL(STRING)} will left adjust a string by removing leading spaces. Spaces are inserted at the end of the string as needed. @item @emph{Standard}: ! Fortran 90 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = ADJUSTL(STRING)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STRING} @tab The type shall be @code{CHARACTER}. @end multitable @item @emph{Return value}: ! The return value is of type @code{CHARACTER} and of the same kind as ! @var{STRING} where leading spaces are removed and the same number of ! spaces are inserted on the end of @var{STRING}. @item @emph{Example}: @smallexample *************** end program test_adjustl *** 665,681 **** @table @asis @item @emph{Description}: ! @code{ADJUSTR(STR)} will right adjust a string by removing trailing spaces. Spaces are inserted at the start of the string as needed. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = ADJUSTR(STR)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 --- 675,691 ---- @table @asis @item @emph{Description}: ! @code{ADJUSTR(STRING)} will right adjust a string by removing trailing spaces. Spaces are inserted at the start of the string as needed. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = ADJUSTR(STRING)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 *************** Elemental function *** 683,691 **** @end multitable @item @emph{Return value}: ! The return value is of type @code{CHARACTER} where trailing spaces ! are removed and the same number of spaces are inserted at the start ! of @var{STR}. @item @emph{Example}: @smallexample --- 693,701 ---- @end multitable @item @emph{Return value}: ! The return value is of type @code{CHARACTER} and of the same kind as ! @var{STRING} where trailing spaces are removed and the same number of ! spaces are inserted at the start of @var{STRING}. @item @emph{Example}: @smallexample *************** for compatibility with @command{g77}, an *** 718,724 **** strongly discouraged. @item @emph{Standard}: ! F77 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function --- 728,734 ---- strongly discouraged. @item @emph{Standard}: ! Fortran 77 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function *************** Elemental function *** 728,738 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{Z} @tab The type of the argument shall be @code{COMPLEX(*)}. @end multitable @item @emph{Return value}: ! The return value is of type real with the kind type parameter of the argument. @item @emph{Example}: --- 738,748 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{Z} @tab The type of the argument shall be @code{COMPLEX}. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL} with the kind type parameter of the argument. @item @emph{Example}: *************** end program test_aimag *** 750,757 **** @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard @item @code{DIMAG(Z)} @tab @code{COMPLEX(8) Z} @tab @code{REAL(8)} @tab GNU extension ! @item @code{IMAG(Z)} @tab @code{COMPLEX(*) Z} @tab @code{REAL(*)} @tab GNU extension ! @item @code{IMAGPART(Z)} @tab @code{COMPLEX(*) Z} @tab @code{REAL(*)} @tab GNU extension @end multitable @end table --- 760,767 ---- @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard @item @code{DIMAG(Z)} @tab @code{COMPLEX(8) Z} @tab @code{REAL(8)} @tab GNU extension ! @item @code{IMAG(Z)} @tab @code{COMPLEX Z} @tab @code{REAL} @tab GNU extension ! @item @code{IMAGPART(Z)} @tab @code{COMPLEX Z} @tab @code{REAL} @tab GNU extension @end multitable @end table *************** end program test_aimag *** 766,796 **** @table @asis @item @emph{Description}: ! @code{AINT(X [, KIND])} truncates its argument to a whole number. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = AINT(X [, KIND])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type of the argument shall be @code{REAL(*)}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER(*)} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: ! The return value is of type real with the kind type parameter of the argument if the optional @var{KIND} is absent; otherwise, the kind type parameter will be given by @var{KIND}. If the magnitude of ! @var{X} is less than one, then @code{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 @var{X}. --- 776,805 ---- @table @asis @item @emph{Description}: ! @code{AINT(A [, KIND])} truncates its argument to a whole number. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = AINT(A [, KIND])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A} @tab The type of the argument shall be @code{REAL}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL} with the kind type parameter of the argument if the optional @var{KIND} is absent; otherwise, the kind type parameter will be given by @var{KIND}. If the magnitude of ! @var{X} is less than one, @code{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 @var{X}. *************** end program test_aint *** 809,815 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DINT(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab F77 and later @end multitable @end table --- 818,824 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DINT(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @end multitable @end table *************** after 3 seconds. *** 878,884 **** in the array along dimension @var{DIM}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 887,893 ---- in the array along dimension @var{DIM}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Transformational function *** 888,901 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{MASK} @tab The type of the argument shall be @code{LOGICAL(*)} and it shall not be scalar. @item @var{DIM} @tab (Optional) @var{DIM} shall be a scalar integer with a value that lies between one and the rank of @var{MASK}. @end multitable @item @emph{Return value}: ! @code{ALL(MASK)} returns a scalar value of type @code{LOGICAL(*)} where the kind type parameter is the same as the kind type parameter of @var{MASK}. If @var{DIM} is present, then @code{ALL(MASK, DIM)} returns an array with the rank of @var{MASK} minus 1. The shape is determined from --- 897,910 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{MASK} @tab The type of the argument shall be @code{LOGICAL} and it shall not be scalar. @item @var{DIM} @tab (Optional) @var{DIM} shall be a scalar integer with a value that lies between one and the rank of @var{MASK}. @end multitable @item @emph{Return value}: ! @code{ALL(MASK)} returns a scalar value of type @code{LOGICAL} where the kind type parameter is the same as the kind type parameter of @var{MASK}. If @var{DIM} is present, then @code{ALL(MASK, DIM)} returns an array with the rank of @var{MASK} minus 1. The shape is determined from *************** end program test_all *** 940,964 **** @table @asis @item @emph{Description}: ! @code{ALLOCATED(X)} checks the status of whether @var{X} is allocated. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function @item @emph{Syntax}: ! @code{RESULT = ALLOCATED(X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The argument shall be an @code{ALLOCATABLE} array. @end multitable @item @emph{Return value}: The return value is a scalar @code{LOGICAL} with the default logical ! kind type parameter. If @var{X} is allocated, @code{ALLOCATED(X)} is @code{.TRUE.}; otherwise, it returns @code{.FALSE.} @item @emph{Example}: --- 949,973 ---- @table @asis @item @emph{Description}: ! @code{ALLOCATED(ARRAY)} checks the status of whether @var{X} is allocated. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Inquiry function @item @emph{Syntax}: ! @code{RESULT = ALLOCATED(ARRAY)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{ARRAY} @tab The argument shall be an @code{ALLOCATABLE} array. @end multitable @item @emph{Return value}: The return value is a scalar @code{LOGICAL} with the default logical ! kind type parameter. If @var{ARRAY} is allocated, @code{ALLOCATED(ARRAY)} is @code{.TRUE.}; otherwise, it returns @code{.FALSE.} @item @emph{Example}: *************** is @code{.TRUE.}; otherwise, it returns *** 966,972 **** program test_allocated integer :: i = 4 real(4), allocatable :: x(:) ! if (allocated(x) .eqv. .false.) allocate(x(i)) end program test_allocated @end smallexample @end table --- 975,981 ---- program test_allocated integer :: i = 4 real(4), allocatable :: x(:) ! if (.not. allocated(x)) allocate(x(i)) end program test_allocated @end smallexample @end table *************** Function *** 998,1010 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be either @code{INTEGER(*)} or @code{LOGICAL}. ! @item @var{J} @tab The type shall be either @code{INTEGER(*)} or @code{LOGICAL}. @end multitable @item @emph{Return value}: ! The return type is either @code{INTEGER(*)} or @code{LOGICAL} after ! cross-promotion of the arguments. @item @emph{Example}: @smallexample --- 1007,1022 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be either a scalar @code{INTEGER} ! type or a scalar @code{LOGICAL} type. ! @item @var{J} @tab The type shall be the same as the type of @var{I}. @end multitable @item @emph{Return value}: ! The return type is either a scalar @code{INTEGER} or a scalar ! @code{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. @item @emph{Example}: @smallexample *************** END PROGRAM *** 1019,1025 **** @end smallexample @item @emph{See also}: ! F95 elemental function: @ref{IAND} @end table --- 1031,1037 ---- @end smallexample @item @emph{See also}: ! Fortran 95 elemental function: @ref{IAND} @end table *************** F95 elemental function: @ref{IAND} *** 1033,1063 **** @table @asis @item @emph{Description}: ! @code{ANINT(X [, KIND])} rounds its argument to the nearest whole number. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = ANINT(X [, KIND])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type of the argument shall be @code{REAL(*)}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER(*)} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: The return value is of type real with the kind type parameter of the argument if the optional @var{KIND} is absent; otherwise, the kind ! type parameter will be given by @var{KIND}. If @var{X} is greater than ! zero, then @code{ANINT(X)} returns @code{AINT(X+0.5)}. If @var{X} is ! less than or equal to zero, then it returns @code{AINT(X-0.5)}. @item @emph{Example}: @smallexample --- 1045,1074 ---- @table @asis @item @emph{Description}: ! @code{ANINT(A [, KIND])} rounds its argument to the nearest whole number. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = ANINT(A [, KIND])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A} @tab The type of the argument shall be @code{REAL}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: The return value is of type real with the kind type parameter of the argument if the optional @var{KIND} is absent; otherwise, the kind ! type parameter will be given by @var{KIND}. If @var{A} is greater than ! zero, @code{ANINT(A)} returns @code{AINT(X+0.5)}. If @var{A} is ! less than or equal to zero then it returns @code{AINT(X-0.5)}. @item @emph{Example}: @smallexample *************** end program test_anint *** 1074,1080 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DNINT(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab F77 and later @end multitable @end table --- 1085,1091 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DNINT(A)} @tab @code{REAL(8) A} @tab @code{REAL(8)} @tab Fortran 77 and later @end multitable @end table *************** end program test_anint *** 1092,1098 **** @var{MASK} along dimension @var{DIM} are @code{.TRUE.}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 1103,1109 ---- @var{MASK} along dimension @var{DIM} are @code{.TRUE.}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Transformational function *** 1102,1115 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{MASK} @tab The type of the argument shall be @code{LOGICAL(*)} and it shall not be scalar. @item @var{DIM} @tab (Optional) @var{DIM} shall be a scalar integer with a value that lies between one and the rank of @var{MASK}. @end multitable @item @emph{Return value}: ! @code{ANY(MASK)} returns a scalar value of type @code{LOGICAL(*)} where the kind type parameter is the same as the kind type parameter of @var{MASK}. If @var{DIM} is present, then @code{ANY(MASK, DIM)} returns an array with the rank of @var{MASK} minus 1. The shape is determined from --- 1113,1126 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{MASK} @tab The type of the argument shall be @code{LOGICAL} and it shall not be scalar. @item @var{DIM} @tab (Optional) @var{DIM} shall be a scalar integer with a value that lies between one and the rank of @var{MASK}. @end multitable @item @emph{Return value}: ! @code{ANY(MASK)} returns a scalar value of type @code{LOGICAL} where the kind type parameter is the same as the kind type parameter of @var{MASK}. If @var{DIM} is present, then @code{ANY(MASK, DIM)} returns an array with the rank of @var{MASK} minus 1. The shape is determined from *************** end program test_any *** 1159,1165 **** @code{ASIN(X)} computes the arcsine of its @var{X} (inverse of @code{SIN(X)}). @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 1170,1176 ---- @code{ASIN(X)} computes the arcsine of its @var{X} (inverse of @code{SIN(X)}). @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 1169,1180 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}, and a magnitude that is ! less than one. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL(*)} and it lies in the range @math{-\pi / 2 \leq \asin (x) \leq \pi / 2}. The kind type parameter is the same as @var{X}. --- 1180,1191 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL}, and a magnitude that is ! less than or equal to one. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL} and it lies in the range @math{-\pi / 2 \leq \asin (x) \leq \pi / 2}. The kind type parameter is the same as @var{X}. *************** end program test_asin *** 1189,1195 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DASIN(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab F77 and later @end multitable @item @emph{See also}: --- 1200,1206 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DASIN(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @end multitable @item @emph{See also}: *************** Inverse function: @ref{SIN} *** 1213,1219 **** @code{ASINH(X)} computes the hyperbolic arcsine of @var{X} (inverse of @code{SINH(X)}). @item @emph{Standard}: ! GNU extension @item @emph{Class}: Elemental function --- 1224,1230 ---- @code{ASINH(X)} computes the hyperbolic arcsine of @var{X} (inverse of @code{SINH(X)}). @item @emph{Standard}: ! Fortran 2008 and later @item @emph{Class}: Elemental function *************** Elemental function *** 1223,1234 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}, with @var{X} a real number. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL(*)} and it lies in the ! range @math{-\infty \leq \asinh (x) \leq \infty}. @item @emph{Example}: @smallexample --- 1234,1244 ---- @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}. @item @emph{Example}: @smallexample *************** Inverse function: @ref{SINH} *** 1258,1311 **** @table @asis @item @emph{Description}: ! @code{ASSOCIATED(PTR [, TGT])} determines the status of the pointer @var{PTR} ! or if @var{PTR} is associated with the target @var{TGT}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function @item @emph{Syntax}: ! @code{RESULT = ASSOCIATED(PTR [, TGT])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{PTR} @tab @var{PTR} shall have the @code{POINTER} attribute and ! it can be of any type. ! @item @var{TGT} @tab (Optional) @var{TGT} shall be a @code{POINTER} or ! a @code{TARGET}. It must have the same type, kind type parameter, and ! array rank as @var{PTR}. @end multitable ! The status of neither @var{PTR} nor @var{TGT} can be undefined. @item @emph{Return value}: ! @code{ASSOCIATED(PTR)} returns a scalar value of type @code{LOGICAL(4)}. There are several cases: @table @asis ! @item (A) If the optional @var{TGT} is not present, then @code{ASSOCIATED(PTR)} ! is true if @var{PTR} is associated with a target; otherwise, it returns false. ! @item (B) If @var{TGT} is present and a scalar target, the result is true if ! @var{TGT} ! is not a 0 sized storage sequence and the target associated with @var{PTR} ! occupies the same storage units. If @var{PTR} is disassociated, then the ! result is false. ! @item (C) If @var{TGT} is present and an array target, the result is true if ! @var{TGT} and @var{PTR} have the same shape, are not 0 sized arrays, are ! arrays whose elements are not 0 sized storage sequences, and @var{TGT} and ! @var{PTR} occupy the same storage units in array element order. ! As in case(B), the result is false, if @var{PTR} is disassociated. ! @item (D) If @var{TGT} is present and an scalar pointer, the result is true if ! target associated with @var{PTR} and the target associated with @var{TGT} ! are not 0 sized storage sequences and occupy the same storage units. ! The result is false, if either @var{TGT} or @var{PTR} is disassociated. ! @item (E) If @var{TGT} is present and an array pointer, the result is true if ! target associated with @var{PTR} and the target associated with @var{TGT} ! have the same shape, are not 0 sized arrays, are arrays whose elements are ! not 0 sized storage sequences, and @var{TGT} and @var{PTR} occupy the same ! storage units in array element order. ! The result is false, if either @var{TGT} or @var{PTR} is disassociated. @end table @item @emph{Example}: --- 1268,1322 ---- @table @asis @item @emph{Description}: ! @code{ASSOCIATED(POINTER [, TARGET])} determines the status of the pointer ! @var{POINTER} or if @var{POINTER} is associated with the target @var{TARGET}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Inquiry function @item @emph{Syntax}: ! @code{RESULT = ASSOCIATED(POINTER [, TARGET])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{POINTER} @tab @var{POINTER} shall have the @code{POINTER} attribute ! and it can be of any type. ! @item @var{TARGET} @tab (Optional) @var{TARGET} shall be a pointer or ! a target. It must have the same type, kind type parameter, and ! array rank as @var{POINTER}. @end multitable ! The association status of neither @var{POINTER} nor @var{TARGET} shall be ! undefined. @item @emph{Return value}: ! @code{ASSOCIATED(POINTER)} returns a scalar value of type @code{LOGICAL(4)}. There are several cases: @table @asis ! @item (A) When the optional @var{TARGET} is not present then ! @code{ASSOCIATED(POINTER)} is true if @var{POINTER} is associated with a target; otherwise, it returns false. ! @item (B) If @var{TARGET} is present and a scalar target, the result is true if ! @var{TARGET} is not a zero-sized storage sequence and the target associated with @var{POINTER} occupies the same storage units. If @var{POINTER} is ! disassociated, the result is false. ! @item (C) If @var{TARGET} is present and an array target, the result is true if ! @var{TARGET} and @var{POINTER} have the same shape, are not zero-sized arrays, ! are arrays whose elements are not zero-sized storage sequences, and ! @var{TARGET} and @var{POINTER} occupy the same storage units in array element ! order. ! As in case(B), the result is false, if @var{POINTER} is disassociated. ! @item (D) If @var{TARGET} is present and an scalar pointer, the result is true ! if @var{TARGET} is associated with @var{POINTER}, the target associated with ! @var{TARGET} are not zero-sized storage sequences and occupy the same storage ! units. ! The result is false, if either @var{TARGET} or @var{POINTER} is disassociated. ! @item (E) If @var{TARGET} is present and an array pointer, the result is true if ! target associated with @var{POINTER} and the target associated with @var{TARGET} ! have the same shape, are not zero-sized arrays, are arrays whose elements are ! not zero-sized storage sequences, and @var{TARGET} and @var{POINTER} occupy ! the same storage units in array element order. ! The result is false, if either @var{TARGET} or @var{POINTER} is disassociated. @end table @item @emph{Example}: *************** end program test_associated *** 1338,1344 **** @code{ATAN(X)} computes the arctangent of @var{X}. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 1349,1355 ---- @code{ATAN(X)} computes the arctangent of @var{X}. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 1348,1358 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL(*)} and it lies in the range @math{ - \pi / 2 \leq \atan (x) \leq \pi / 2}. @item @emph{Example}: --- 1359,1369 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL}. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL} and it lies in the range @math{ - \pi / 2 \leq \atan (x) \leq \pi / 2}. @item @emph{Example}: *************** end program test_atan *** 1366,1372 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DATAN(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab F77 and later @end multitable @item @emph{See also}: --- 1377,1383 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DATAN(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @end multitable @item @emph{See also}: *************** Inverse function: @ref{TAN} *** 1385,1405 **** @table @asis @item @emph{Description}: ! @code{ATAN2(Y,X)} computes the arctangent of the complex number @math{X + i Y}. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = ATAN2(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 --- 1396,1416 ---- @table @asis @item @emph{Description}: ! @code{ATAN2(Y, X)} computes the arctangent of the complex number @math{X + i Y}. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = ATAN2(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 *************** end program test_atan2 *** 1424,1430 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DATAN2(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab F77 and later @end multitable @end table --- 1435,1441 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DATAN2(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @end multitable @end table *************** end program test_atan2 *** 1445,1451 **** of @code{TANH(X)}). @item @emph{Standard}: ! GNU extension @item @emph{Class}: Elemental function --- 1456,1462 ---- of @code{TANH(X)}). @item @emph{Standard}: ! Fortran 2008 and later @item @emph{Class}: Elemental function *************** Elemental function *** 1455,1467 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)} with a magnitude ! that is less than or equal to one. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL(*)} and it lies in the ! range @math{-\infty \leq \atanh(x) \leq \infty}. @item @emph{Example}: @smallexample --- 1466,1476 ---- @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}. @item @emph{Example}: @smallexample *************** Inverse function: @ref{TANH} *** 1483,1522 **** ! @node BESJ0 ! @section @code{BESJ0} --- Bessel function of the first kind of order 0 @fnindex BESJ0 @fnindex DBESJ0 @cindex Bessel function, first kind @table @asis @item @emph{Description}: ! @code{BESJ0(X)} computes the Bessel function of the first kind of order 0 ! of @var{X}. @item @emph{Standard}: ! GNU extension @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = BESJ0(X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}, and it shall be scalar. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL(*)} and it lies in the ! range @math{ - 0.4027... \leq Bessel (0,x) \leq 1}. @item @emph{Example}: @smallexample program test_besj0 real(8) :: x = 0.0_8 ! x = besj0(x) end program test_besj0 @end smallexample --- 1492,1534 ---- ! @node BESSEL_J0 ! @section @code{BESSEL_J0} --- Bessel function of the first kind of order 0 ! @fnindex BESSEL_J0 @fnindex BESJ0 @fnindex DBESJ0 @cindex Bessel function, first kind @table @asis @item @emph{Description}: ! @code{BESSEL_J0(X)} computes the Bessel function of the first kind of ! order 0 of @var{X}. This function is available under the name ! @code{BESJ0} as a GNU extension. @item @emph{Standard}: ! Fortran 2008 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = BESSEL_J0(X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL}, and it shall be scalar. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL} and lies in the ! range @math{ - 0.4027... \leq Bessel (0,x) \leq 1}. It has the same ! kind as @var{X}. @item @emph{Example}: @smallexample program test_besj0 real(8) :: x = 0.0_8 ! x = bessel_j0(x) end program test_besj0 @end smallexample *************** end program test_besj0 *** 1529,1568 **** ! @node BESJ1 ! @section @code{BESJ1} --- Bessel function of the first kind of order 1 @fnindex BESJ1 @fnindex DBESJ1 @cindex Bessel function, first kind @table @asis @item @emph{Description}: ! @code{BESJ1(X)} computes the Bessel function of the first kind of order 1 ! of @var{X}. @item @emph{Standard}: ! GNU extension @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = BESJ1(X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}, and it shall be scalar. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL(*)} and it lies in the ! range @math{ - 0.5818... \leq Bessel (0,x) \leq 0.5818 }. @item @emph{Example}: @smallexample program test_besj1 real(8) :: x = 1.0_8 ! x = besj1(x) end program test_besj1 @end smallexample --- 1541,1583 ---- ! @node BESSEL_J1 ! @section @code{BESSEL_J1} --- Bessel function of the first kind of order 1 ! @fnindex BESSEL_J1 @fnindex BESJ1 @fnindex DBESJ1 @cindex Bessel function, first kind @table @asis @item @emph{Description}: ! @code{BESSEL_J1(X)} computes the Bessel function of the first kind of ! order 1 of @var{X}. This function is available under the name ! @code{BESJ1} as a GNU extension. @item @emph{Standard}: ! Fortran 2008 @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = BESSEL_J1(X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL}, and it shall be scalar. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL} and it lies in the ! range @math{ - 0.5818... \leq Bessel (0,x) \leq 0.5818 }. It has the same ! kind as @var{X}. @item @emph{Example}: @smallexample program test_besj1 real(8) :: x = 1.0_8 ! x = bessel_j1(x) end program test_besj1 @end smallexample *************** end program test_besj1 *** 1575,1662 **** ! @node BESJN ! @section @code{BESJN} --- Bessel function of the first kind @fnindex BESJN @fnindex DBESJN @cindex Bessel function, first kind @table @asis @item @emph{Description}: ! @code{BESJN(N, X)} computes the Bessel function of the first kind of order ! @var{N} of @var{X}. If both arguments are arrays, their ranks and shapes shall conform. @item @emph{Standard}: ! GNU extension @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = BESJN(N, X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{N} @tab Shall be a scalar or an array of type @code{INTEGER(*)}. ! @item @var{X} @tab Shall be a scalar or an array of type @code{REAL(*)}. @end multitable @item @emph{Return value}: ! The return value is a scalar of type @code{REAL(*)}. @item @emph{Example}: @smallexample program test_besjn real(8) :: x = 1.0_8 ! x = besjn(5,x) end program test_besjn @end smallexample @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DBESJN(X)} @tab @code{INTEGER(*) N} @tab @code{REAL(8)} @tab GNU extension @item @tab @code{REAL(8) X} @tab @tab @end multitable @end table ! @node BESY0 ! @section @code{BESY0} --- Bessel function of the second kind of order 0 @fnindex BESY0 @fnindex DBESY0 @cindex Bessel function, second kind @table @asis @item @emph{Description}: ! @code{BESY0(X)} computes the Bessel function of the second kind of order 0 ! of @var{X}. @item @emph{Standard}: ! GNU extension @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = BESY0(X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}, and it shall be scalar. @end multitable @item @emph{Return value}: ! The return value is a scalar of type @code{REAL(*)}. @item @emph{Example}: @smallexample program test_besy0 real(8) :: x = 0.0_8 ! x = besy0(x) end program test_besy0 @end smallexample --- 1590,1683 ---- ! @node BESSEL_JN ! @section @code{BESSEL_JN} --- Bessel function of the first kind ! @fnindex BESSEL_JN @fnindex BESJN @fnindex DBESJN @cindex Bessel function, first kind @table @asis @item @emph{Description}: ! @code{BESSEL_JN(N, X)} computes the Bessel function of the first kind of ! order @var{N} of @var{X}. This function is available under the name ! @code{BESJN} as a GNU extension. If both arguments are arrays, their ranks and shapes shall conform. @item @emph{Standard}: ! Fortran 2008 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = BESSEL_JN(N, X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{N} @tab Shall be a scalar or an array of type @code{INTEGER}. ! @item @var{X} @tab Shall be a scalar or an array of type @code{REAL}. @end multitable @item @emph{Return value}: ! The return value is a scalar of type @code{REAL}. It has the same ! kind as @var{X}. @item @emph{Example}: @smallexample program test_besjn real(8) :: x = 1.0_8 ! x = bessel_jn(5,x) end program test_besjn @end smallexample @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DBESJN(X)} @tab @code{INTEGER N} @tab @code{REAL(8)} @tab GNU extension @item @tab @code{REAL(8) X} @tab @tab @end multitable @end table ! @node BESSEL_Y0 ! @section @code{BESSEL_Y0} --- Bessel function of the second kind of order 0 ! @fnindex BESSEL_Y0 @fnindex BESY0 @fnindex DBESY0 @cindex Bessel function, second kind @table @asis @item @emph{Description}: ! @code{BESSEL_Y0(X)} computes the Bessel function of the second kind of ! order 0 of @var{X}. This function is available under the name ! @code{BESY0} as a GNU extension. @item @emph{Standard}: ! Fortran 2008 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = BESSEL_Y0(X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL}, and it shall be scalar. @end multitable @item @emph{Return value}: ! The return value is a scalar of type @code{REAL}. It has the same ! kind as @var{X}. @item @emph{Example}: @smallexample program test_besy0 real(8) :: x = 0.0_8 ! x = bessel_y0(x) end program test_besy0 @end smallexample *************** end program test_besy0 *** 1669,1707 **** ! @node BESY1 ! @section @code{BESY1} --- Bessel function of the second kind of order 1 @fnindex BESY1 @fnindex DBESY1 @cindex Bessel function, second kind @table @asis @item @emph{Description}: ! @code{BESY1(X)} computes the Bessel function of the second kind of order 1 ! of @var{X}. @item @emph{Standard}: ! GNU extension @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = BESY1(X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}, and it shall be scalar. @end multitable @item @emph{Return value}: ! The return value is a scalar of type @code{REAL(*)}. @item @emph{Example}: @smallexample program test_besy1 real(8) :: x = 1.0_8 ! x = besy1(x) end program test_besy1 @end smallexample --- 1690,1731 ---- ! @node BESSEL_Y1 ! @section @code{BESSEL_Y1} --- Bessel function of the second kind of order 1 ! @fnindex BESSEL_Y1 @fnindex BESY1 @fnindex DBESY1 @cindex Bessel function, second kind @table @asis @item @emph{Description}: ! @code{BESSEL_Y1(X)} computes the Bessel function of the second kind of ! order 1 of @var{X}. This function is available under the name ! @code{BESY1} as a GNU extension. @item @emph{Standard}: ! Fortran 2008 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = BESSEL_Y1(X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL}, and it shall be scalar. @end multitable @item @emph{Return value}: ! The return value is a scalar of type @code{REAL}. It has the same ! kind as @var{X}. @item @emph{Example}: @smallexample program test_besy1 real(8) :: x = 1.0_8 ! x = bessel_y1(x) end program test_besy1 @end smallexample *************** end program test_besy1 *** 1714,1762 **** ! @node BESYN ! @section @code{BESYN} --- Bessel function of the second kind @fnindex BESYN @fnindex DBESYN @cindex Bessel function, second kind @table @asis @item @emph{Description}: ! @code{BESYN(N, X)} computes the Bessel function of the second kind of order ! @var{N} of @var{X}. If both arguments are arrays, their ranks and shapes shall conform. @item @emph{Standard}: ! GNU extension @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = BESYN(N, X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{N} @tab Shall be a scalar or an array of type @code{INTEGER(*)}. ! @item @var{X} @tab Shall be a scalar or an array of type @code{REAL(*)}. @end multitable @item @emph{Return value}: ! The return value is a scalar of type @code{REAL(*)}. @item @emph{Example}: @smallexample program test_besyn real(8) :: x = 1.0_8 ! x = besyn(5,x) end program test_besyn @end smallexample @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DBESYN(N,X)} @tab @code{INTEGER(*) N} @tab @code{REAL(8)} @tab GNU extension @item @tab @code{REAL(8) X} @tab @tab @end multitable @end table --- 1738,1789 ---- ! @node BESSEL_YN ! @section @code{BESSEL_YN} --- Bessel function of the second kind ! @fnindex BESSEL_YN @fnindex BESYN @fnindex DBESYN @cindex Bessel function, second kind @table @asis @item @emph{Description}: ! @code{BESSEL_YN(N, X)} computes the Bessel function of the second kind of ! order @var{N} of @var{X}. This function is available under the name ! @code{BESYN} as a GNU extension. If both arguments are arrays, their ranks and shapes shall conform. @item @emph{Standard}: ! Fortran 2008 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = BESSEL_YN(N, X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{N} @tab Shall be a scalar or an array of type @code{INTEGER}. ! @item @var{X} @tab Shall be a scalar or an array of type @code{REAL}. @end multitable @item @emph{Return value}: ! The return value is a scalar of type @code{REAL}. It has the same ! kind as @var{X}. @item @emph{Example}: @smallexample program test_besyn real(8) :: x = 1.0_8 ! x = bessel_yn(5,x) end program test_besyn @end smallexample @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DBESYN(N,X)} @tab @code{INTEGER N} @tab @code{REAL(8)} @tab GNU extension @item @tab @code{REAL(8) X} @tab @tab @end multitable @end table *************** end program test_besyn *** 1772,1781 **** @table @asis @item @emph{Description}: @code{BIT_SIZE(I)} returns the number of bits (integer precision plus sign bit) ! represented by the type of @var{I}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function --- 1799,1809 ---- @table @asis @item @emph{Description}: @code{BIT_SIZE(I)} returns the number of bits (integer precision plus sign bit) ! represented by the type of @var{I}. The result of @code{BIT_SIZE(I)} is ! independent of the actual value of @var{I}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Inquiry function *************** Inquiry function *** 1785,1795 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER(*)}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER(*)} @item @emph{Example}: @smallexample --- 1813,1823 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER} @item @emph{Example}: @smallexample *************** end program test_bit_size *** 1812,1821 **** @table @asis @item @emph{Description}: @code{BTEST(I,POS)} returns logical @code{.TRUE.} if the bit at @var{POS} ! in @var{I} is set. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 1840,1849 ---- @table @asis @item @emph{Description}: @code{BTEST(I,POS)} returns logical @code{.TRUE.} if the bit at @var{POS} ! in @var{I} is set. The counting of the bits starts at 0. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** Elemental function *** 1825,1832 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER(*)}. ! @item @var{POS} @tab The type shall be @code{INTEGER(*)}. @end multitable @item @emph{Return value}: --- 1853,1860 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER}. ! @item @var{POS} @tab The type shall be @code{INTEGER}. @end multitable @item @emph{Return value}: *************** end program test_btest *** 1855,1881 **** @table @asis @item @emph{Description}: ! @code{C_ASSOICATED(c_prt1[, c_ptr2])} determines the status of the C pointer @var{c_ptr1} ! or if @var{c_ptr1} is associated with the target @var{c_ptr2}. @item @emph{Standard}: ! F2003 and later @item @emph{Class}: Inquiry function @item @emph{Syntax}: ! @code{RESULT = C_ASSOICATED(c_prt1[, c_ptr2])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{c_ptr1} @tab Scalar of the type @code{C_PTR} or @code{C_FUNPTR}. ! @item @var{c_ptr2} @tab (Optional) Scalar of the same type as @var{c_ptr1}. @end multitable @item @emph{Return value}: The return value is of type @code{LOGICAL}; it is @code{.false.} if either ! @var{c_ptr1} is a C NULL pointer or if @var{c_ptr1} and @var{c_ptr2} point to different addresses. @item @emph{Example}: --- 1883,1909 ---- @table @asis @item @emph{Description}: ! @code{C_ASSOCIATED(c_prt_1[, c_ptr_2])} determines the status of the C pointer ! @var{c_ptr_1} or if @var{c_ptr_1} is associated with the target @var{c_ptr_2}. @item @emph{Standard}: ! Fortran 2003 and later @item @emph{Class}: Inquiry function @item @emph{Syntax}: ! @code{RESULT = C_ASSOCIATED(c_prt_1[, c_ptr_2])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{c_ptr_1} @tab Scalar of the type @code{C_PTR} or @code{C_FUNPTR}. ! @item @var{c_ptr_2} @tab (Optional) Scalar of the same type as @var{c_ptr_1}. @end multitable @item @emph{Return value}: The return value is of type @code{LOGICAL}; it is @code{.false.} if either ! @var{c_ptr_1} is a C NULL pointer or if @var{c_ptr1} and @var{c_ptr_2} point to different addresses. @item @emph{Example}: *************** end subroutine association_test *** 1905,1911 **** @code{C_FUNLOC(x)} determines the C address of the argument. @item @emph{Standard}: ! F2003 and later @item @emph{Class}: Inquiry function --- 1933,1939 ---- @code{C_FUNLOC(x)} determines the C address of the argument. @item @emph{Standard}: ! Fortran 2003 and later @item @emph{Class}: Inquiry function *************** end program main *** 1959,1972 **** @table @asis @item @emph{Description}: ! @code{C_F_PROCPOINTER(cptr, fptr)} Assign the target of the C function pointer ! @var{cptr} to the Fortran procedure pointer @var{fptr}. Note: Due to the currently lacking support of procedure pointers in GNU Fortran this function is not fully operable. @item @emph{Standard}: ! F2003 and later @item @emph{Class}: Subroutine --- 1987,2000 ---- @table @asis @item @emph{Description}: ! @code{C_F_PROCPOINTER(CPTR, FPTR)} Assign the target of the C function pointer ! @var{CPTR} to the Fortran procedure pointer @var{FPTR}. Note: Due to the currently lacking support of procedure pointers in GNU Fortran this function is not fully operable. @item @emph{Standard}: ! Fortran 2003 and later @item @emph{Class}: Subroutine *************** Subroutine *** 1976,1985 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{cptr} @tab scalar of the type @code{C_FUNPTR}. It is ! @code{INTENT(IN)}. ! @item @var{fptr} @tab procedure pointer interoperable with @var{cptr}. It is ! @code{INTENT(OUT)}. @end multitable @item @emph{Example}: --- 2004,2013 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{CPTR} @tab scalar of the type @code{C_FUNPTR}. It is ! @code{INTENT(IN)}. ! @item @var{FPTR} @tab procedure pointer interoperable with @var{cptr}. It is ! @code{INTENT(OUT)}. @end multitable @item @emph{Example}: *************** end program main *** 2019,2047 **** @table @asis @item @emph{Description}: ! @code{C_F_POINTER(cptr, fptr[, shape])} Assign the target the C pointer ! @var{cptr} to the Fortran pointer @var{fptr} and specify its shape. @item @emph{Standard}: ! F2003 and later @item @emph{Class}: Subroutine @item @emph{Syntax}: ! @code{CALL C_F_POINTER(cptr, fptr[, shape])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{cptr} @tab scalar of the type @code{C_PTR}. It is ! @code{INTENT(IN)}. ! @item @var{fptr} @tab pointer interoperable with @var{cptr}. It is ! @code{INTENT(OUT)}. ! @item @var{shape} @tab (Optional) Rank-one array of type @code{INTEGER} ! with @code{INTENT(IN)}. It shall be present ! if and only if @var{fptr} is an array. The size ! must be equal to the rank of @var{fptr}. @end multitable @item @emph{Example}: --- 2047,2075 ---- @table @asis @item @emph{Description}: ! @code{C_F_POINTER(CPTR, FPTR[, SHAPE])} Assign the target the C pointer ! @var{CPTR} to the Fortran pointer @var{FPTR} and specify its shape. @item @emph{Standard}: ! Fortran 2003 and later @item @emph{Class}: Subroutine @item @emph{Syntax}: ! @code{CALL C_F_POINTER(CPTR, FPTR[, SHAPE])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{CPTR} @tab scalar of the type @code{C_PTR}. It is ! @code{INTENT(IN)}. ! @item @var{FPTR} @tab pointer interoperable with @var{cptr}. It is ! @code{INTENT(OUT)}. ! @item @var{SHAPE} @tab (Optional) Rank-one array of type @code{INTEGER} ! with @code{INTENT(IN)}. It shall be present ! if and only if @var{fptr} is an array. The size ! must be equal to the rank of @var{fptr}. @end multitable @item @emph{Example}: *************** end program main *** 2074,2095 **** @table @asis @item @emph{Description}: ! @code{C_LOC(x)} determines the C address of the argument. @item @emph{Standard}: ! F2003 and later @item @emph{Class}: Inquiry function @item @emph{Syntax}: ! @code{RESULT = C_LOC(x)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{x} @tab Associated scalar pointer or interoperable scalar ! or allocated allocatable variable with @code{TARGET} ! attribute. @end multitable @item @emph{Return value}: --- 2102,2122 ---- @table @asis @item @emph{Description}: ! @code{C_LOC(X)} determines the C address of the argument. @item @emph{Standard}: ! Fortran 2003 and later @item @emph{Class}: Inquiry function @item @emph{Syntax}: ! @code{RESULT = C_LOC(X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab Associated scalar pointer or interoperable scalar ! or allocated allocatable variable with @code{TARGET} attribute. @end multitable @item @emph{Return value}: *************** end subroutine association_test *** 2113,2118 **** --- 2140,2195 ---- @end table + @node C_SIZEOF + @section @code{C_SIZEOF} --- Size in bytes of an expression + @fnindex C_SIZEOF + @cindex expression size + @cindex size of an expression + + @table @asis + @item @emph{Description}: + @code{C_SIZEOF(X)} calculates the number of bytes of storage the + expression @code{X} occupies. + + @item @emph{Standard}: + Fortran 2008 + + @item @emph{Class}: + Intrinsic function + + @item @emph{Syntax}: + @code{N = C_SIZEOF(X)} + + @item @emph{Arguments}: + @multitable @columnfractions .15 .70 + @item @var{X} @tab The argument shall be of any type, rank or shape. + @end multitable + + @item @emph{Return value}: + The return value is of type integer and of the system-dependent kind + @var{C_SIZE_T} (from the @var{ISO_C_BINDING} module). Its value is the + number of bytes occupied by the argument. If the argument has the + @code{POINTER} attribute, the number of bytes of the storage area pointed + to is returned. If the argument is of a derived type with @code{POINTER} + or @code{ALLOCATABLE} components, the return value doesn't account for + the sizes of the data pointed to by these components. + + @item @emph{Example}: + @smallexample + use iso_c_binding + integer(c_int) :: i + real(c_float) :: r, s(5) + print *, (c_sizeof(s)/c_sizeof(r) == 5) + end + @end smallexample + The example will print @code{.TRUE.} unless you are using a platform + where default @code{REAL} variables are unusually padded. + + @item @emph{See also}: + @ref{SIZEOF} + @end table + + @node CEILING @section @code{CEILING} --- Integer ceiling function @fnindex CEILING *************** end subroutine association_test *** 2121,2147 **** @table @asis @item @emph{Description}: ! @code{CEILING(X)} returns the least integer greater than or equal to @var{X}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = CEILING(X [, KIND])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER(*)} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER(KIND)} @item @emph{Example}: @smallexample --- 2198,2224 ---- @table @asis @item @emph{Description}: ! @code{CEILING(A)} returns the least integer greater than or equal to @var{A}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = CEILING(A [, KIND])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A} @tab The type shall be @code{REAL}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER(KIND)} if @var{KIND} is present ! and a default-kind @code{INTEGER} otherwise. @item @emph{Example}: @smallexample *************** end program test_ceiling *** 2170,2176 **** @code{CHAR(I [, KIND])} returns the character represented by the integer @var{I}. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 2247,2253 ---- @code{CHAR(I [, KIND])} returns the character represented by the integer @var{I}. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 2180,2189 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER(*)}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER(*)} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: --- 2257,2265 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: *************** Subroutine, function *** 2236,2246 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{NAME} @tab The type shall be @code{CHARACTER(*)} and shall ! specify a valid path within the file system. @item @var{STATUS} @tab (Optional) @code{INTEGER} status flag of the default ! kind. Returns 0 on success, and a system specific ! and nonzero error code otherwise. @end multitable @item @emph{Example}: --- 2312,2322 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{NAME} @tab The type shall be @code{CHARACTER} of default ! kind and shall specify a valid path within the file system. @item @var{STATUS} @tab (Optional) @code{INTEGER} status flag of the default ! kind. Returns 0 on success, and a system specific and nonzero error code ! otherwise. @end multitable @item @emph{Example}: *************** Subroutine, function *** 2288,2301 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 - @item @var{NAME} @tab Scalar @code{CHARACTER} with the file name. - Trailing blanks are ignored unless the character @code{achar(0)} is - present, then all characters up to and excluding @code{achar(0)} are - used as the file name. ! @item @var{MODE} @tab Scalar @code{CHARACTER} giving the file permission. ! @var{MODE} uses the same syntax as the @var{MODE} argument of ! @code{/bin/chmod}. @item @var{STATUS} @tab (optional) scalar @code{INTEGER}, which is @code{0} on success and nonzero otherwise. --- 2364,2378 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{NAME} @tab Scalar @code{CHARACTER} of default kind with the ! file name. Trailing blanks are ignored unless the character ! @code{achar(0)} is present, then all characters up to and excluding ! @code{achar(0)} are used as the file name. ! ! @item @var{MODE} @tab Scalar @code{CHARACTER} of default kind giving the ! file permission. @var{MODE} uses the same syntax as the @var{MODE} ! argument of @code{/bin/chmod}. @item @var{STATUS} @tab (optional) scalar @code{INTEGER}, which is @code{0} on success and nonzero otherwise. *************** component. If @var{Y} is not present th *** 2343,2349 **** 0.0. If @var{X} is complex then @var{Y} must not be present. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 2420,2426 ---- 0.0. If @var{X} is complex then @var{Y} must not be present. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 2353,2366 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type may be @code{INTEGER(*)}, @code{REAL(*)}, ! or @code{COMPLEX(*)}. @item @var{Y} @tab (Optional; only allowed if @var{X} is not ! @code{COMPLEX(*)}.) May be @code{INTEGER(*)} ! or @code{REAL(*)}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER(*)} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: --- 2430,2441 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type may be @code{INTEGER}, @code{REAL}, ! or @code{COMPLEX}. @item @var{Y} @tab (Optional; only allowed if @var{X} is not ! @code{COMPLEX}.) May be @code{INTEGER} or @code{REAL}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: *************** end program test_cmplx *** 2399,2405 **** command line when the containing program was invoked. @item @emph{Standard}: ! F2003 @item @emph{Class}: Inquiry function --- 2474,2480 ---- command line when the containing program was invoked. @item @emph{Standard}: ! Fortran 2003 and later @item @emph{Class}: Inquiry function *************** Elemental function *** 2453,2460 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type may be @code{INTEGER(*)} or @code{REAL(*)}. ! @item @var{Y} @tab The type may be @code{INTEGER(*)} or @code{REAL(*)}. @end multitable @item @emph{Return value}: --- 2528,2535 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type may be @code{INTEGER} or @code{REAL}. ! @item @var{Y} @tab The type may be @code{INTEGER} or @code{REAL}. @end multitable @item @emph{Return value}: *************** end program test_complex *** 2493,2499 **** then the result is @code{(x, -y)} @item @emph{Standard}: ! F77 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function --- 2568,2574 ---- then the result is @code{(x, -y)} @item @emph{Standard}: ! Fortran 77 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function *************** Elemental function *** 2503,2513 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{Z} @tab The type shall be @code{COMPLEX(*)}. @end multitable @item @emph{Return value}: ! The return value is of type @code{COMPLEX(*)}. @item @emph{Example}: @smallexample --- 2578,2588 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{Z} @tab The type shall be @code{COMPLEX}. @end multitable @item @emph{Return value}: ! The return value is of type @code{COMPLEX}. @item @emph{Example}: @smallexample *************** end program test_conjg *** 2545,2551 **** @code{COS(X)} computes the cosine of @var{X}. @item @emph{Standard}: ! F77 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function --- 2620,2626 ---- @code{COS(X)} computes the cosine of @var{X}. @item @emph{Standard}: ! Fortran 77 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function *************** Elemental function *** 2555,2566 **** @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 type @code{REAL(*)} and it lies in the range @math{ -1 \leq \cos (x) \leq 1}. The kind type parameter is the same as @var{X}. --- 2630,2641 ---- @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 type @code{REAL} and it lies in the range @math{ -1 \leq \cos (x) \leq 1}. The kind type parameter is the same as @var{X}. *************** end program test_cos *** 2575,2582 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DCOS(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab F77 and later ! @item @code{CCOS(X)} @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab F77 and later @item @code{ZCOS(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension @item @code{CDCOS(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension @end multitable --- 2650,2657 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DCOS(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later ! @item @code{CCOS(X)} @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab Fortran 77 and later @item @code{ZCOS(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension @item @code{CDCOS(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension @end multitable *************** Inverse function: @ref{ACOS} *** 2601,2607 **** @code{COSH(X)} computes the hyperbolic cosine of @var{X}. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 2676,2682 ---- @code{COSH(X)} computes the hyperbolic cosine of @var{X}. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 2611,2622 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL(*)} and it is positive ! (@math{ \cosh (x) \geq 0 }. @item @emph{Example}: @smallexample --- 2686,2699 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL}. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL} and it is positive ! (@math{ \cosh (x) \geq 0 }). For a @code{REAL} argument @var{X}, ! @math{ \cosh (x) \geq 1 }. ! The return value is of the same kind as @var{X}. @item @emph{Example}: @smallexample *************** end program test_cosh *** 2629,2635 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DCOSH(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab F77 and later @end multitable @item @emph{See also}: --- 2706,2712 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DCOSH(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @end multitable @item @emph{See also}: *************** Inverse function: @ref{ACOSH} *** 2651,2662 **** @code{COUNT(MASK [, DIM [, KIND]])} counts the number of @code{.TRUE.} elements of @var{MASK} along the dimension of @var{DIM}. If @var{DIM} is ! omitted it is taken to be @code{1}. @var{DIM} is a scaler of type @code{INTEGER} in the range of @math{1 /leq DIM /leq n)} where @math{n} is the rank of @var{MASK}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 2728,2739 ---- @code{COUNT(MASK [, DIM [, KIND]])} counts the number of @code{.TRUE.} elements of @var{MASK} along the dimension of @var{DIM}. If @var{DIM} is ! omitted it is taken to be @code{1}. @var{DIM} is a scalar of type @code{INTEGER} in the range of @math{1 /leq DIM /leq n)} where @math{n} is the rank of @var{MASK}. @item @emph{Standard}: ! Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later @item @emph{Class}: Transformational function *************** Transformational function *** 2669,2676 **** @item @var{MASK} @tab The type shall be @code{LOGICAL}. @item @var{DIM} @tab (Optional) The type shall be @code{INTEGER}. @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: --- 2746,2752 ---- @item @var{MASK} @tab The type shall be @code{LOGICAL}. @item @var{DIM} @tab (Optional) The type shall be @code{INTEGER}. @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: *************** end program test_count *** 2713,2719 **** @table @asis @item @emph{Description}: ! Returns a @code{REAL(*)} value representing the elapsed CPU time in seconds. This is useful for testing segments of code to determine execution time. --- 2789,2795 ---- @table @asis @item @emph{Description}: ! Returns a @code{REAL} value representing the elapsed CPU time in seconds. This is useful for testing segments of code to determine execution time. *************** this subroutine, as shown in the example *** 2728,2734 **** @item @emph{Standard}: ! F95 and later @item @emph{Class}: Subroutine --- 2804,2810 ---- @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Subroutine *************** Subroutine *** 2738,2744 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{TIME} @tab The type shall be @code{REAL(*)} with @code{INTENT(OUT)}. @end multitable @item @emph{Return value}: --- 2814,2820 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{TIME} @tab The type shall be @code{REAL} with @code{INTENT(OUT)}. @end multitable @item @emph{Return value}: *************** end program test_cpu_time *** 2772,2778 **** @item @emph{Description}: @code{CSHIFT(ARRAY, SHIFT [, DIM])} performs a circular shift on elements of @var{ARRAY} along the dimension of @var{DIM}. If @var{DIM} is omitted it is ! taken to be @code{1}. @var{DIM} is a scaler of type @code{INTEGER} in the range of @math{1 /leq DIM /leq n)} where @math{n} is the rank of @var{ARRAY}. If the rank of @var{ARRAY} is one, then all elements of @var{ARRAY} are shifted by @var{SHIFT} places. If rank is greater than one, then all complete rank one --- 2848,2854 ---- @item @emph{Description}: @code{CSHIFT(ARRAY, SHIFT [, DIM])} performs a circular shift on elements of @var{ARRAY} along the dimension of @var{DIM}. If @var{DIM} is omitted it is ! taken to be @code{1}. @var{DIM} is a scalar of type @code{INTEGER} in the range of @math{1 /leq DIM /leq n)} where @math{n} is the rank of @var{ARRAY}. If the rank of @var{ARRAY} is one, then all elements of @var{ARRAY} are shifted by @var{SHIFT} places. If rank is greater than one, then all complete rank one *************** sections of @var{ARRAY} along the given *** 2780,2786 **** shifted out one end of each rank one section are shifted back in the other end. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 2856,2862 ---- shifted out one end of each rank one section are shifted back in the other end. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Subroutine, function *** 2846,2852 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{TIME} @tab The type shall be of type @code{INTEGER(KIND=8)}. ! @item @var{RESULT} @tab The type shall be of type @code{CHARACTER}. @end multitable @item @emph{Return value}: --- 2922,2929 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{TIME} @tab The type shall be of type @code{INTEGER(KIND=8)}. ! @item @var{RESULT} @tab The type shall be of type @code{CHARACTER} and ! of default kind. @end multitable @item @emph{Return value}: *************** Unavailable time and date parameters ret *** 2900,2909 **** @item @tab @code{VALUE(6)}: @tab The minutes of the hour @item @tab @code{VALUE(7)}: @tab The seconds of the minute @item @tab @code{VALUE(8)}: @tab The milliseconds of the second ! @end multitable @item @emph{Standard}: ! F95 and later @item @emph{Class}: Subroutine --- 2977,2986 ---- @item @tab @code{VALUE(6)}: @tab The minutes of the hour @item @tab @code{VALUE(7)}: @tab The seconds of the minute @item @tab @code{VALUE(8)}: @tab The milliseconds of the second ! @end multitable @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Subroutine *************** Subroutine *** 2913,2921 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{DATE} @tab (Optional) The type shall be @code{CHARACTER(8)} or larger. ! @item @var{TIME} @tab (Optional) The type shall be @code{CHARACTER(10)} or larger. ! @item @var{ZONE} @tab (Optional) The type shall be @code{CHARACTER(5)} or larger. @item @var{VALUES}@tab (Optional) The type shall be @code{INTEGER(8)}. @end multitable --- 2990,3001 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{DATE} @tab (Optional) The type shall be @code{CHARACTER(LEN=8)} ! or larger, and of default kind. ! @item @var{TIME} @tab (Optional) The type shall be @code{CHARACTER(LEN=10)} ! or larger, and of default kind. ! @item @var{ZONE} @tab (Optional) The type shall be @code{CHARACTER(LEN=5)} ! or larger, and of default kind. @item @var{VALUES}@tab (Optional) The type shall be @code{INTEGER(8)}. @end multitable *************** end program test_time_and_date *** 2952,2972 **** @table @asis @item @emph{Description}: ! @code{DBLE(X)} Converts @var{X} to double precision real type. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = DBLE(X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{INTEGER(*)}, @code{REAL(*)}, ! or @code{COMPLEX(*)}. @end multitable @item @emph{Return value}: --- 3032,3052 ---- @table @asis @item @emph{Description}: ! @code{DBLE(A)} Converts @var{A} to double precision real type. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = DBLE(A)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A} @tab The type shall be @code{INTEGER}, @code{REAL}, ! or @code{COMPLEX}. @end multitable @item @emph{Return value}: *************** Elemental function *** 3012,3021 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type may be @code{INTEGER(*)}, @code{REAL(*)}, ! or @code{COMPLEX(*)}. ! @item @var{Y} @tab (Optional if @var{X} is not @code{COMPLEX(*)}.) May be ! @code{INTEGER(*)} or @code{REAL(*)}. @end multitable @item @emph{Return value}: --- 3092,3101 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type may be @code{INTEGER}, @code{REAL}, ! or @code{COMPLEX}. ! @item @var{Y} @tab (Optional if @var{X} is not @code{COMPLEX}.) May be ! @code{INTEGER} or @code{REAL}. @end multitable @item @emph{Return value}: *************** end program test_dcmplx *** 3045,3051 **** @table @asis @item @emph{Description}: ! @code{DFLOAT(X)} Converts @var{X} to double precision real type. @item @emph{Standard}: GNU extension --- 3125,3131 ---- @table @asis @item @emph{Description}: ! @code{DFLOAT(A)} Converts @var{A} to double precision real type. @item @emph{Standard}: GNU extension *************** GNU extension *** 3054,3064 **** Elemental function @item @emph{Syntax}: ! @code{RESULT = DFLOAT(X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{INTEGER(*)}. @end multitable @item @emph{Return value}: --- 3134,3144 ---- Elemental function @item @emph{Syntax}: ! @code{RESULT = DFLOAT(A)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A} @tab The type shall be @code{INTEGER}. @end multitable @item @emph{Return value}: *************** end program test_dfloat *** 3079,3096 **** @node DIGITS ! @section @code{DIGITS} --- Significant digits function @fnindex DIGITS @cindex model representation, significant digits @table @asis @item @emph{Description}: ! @code{DIGITS(X)} returns the number of significant digits of the internal model ! representation of @var{X}. For example, on a system using a 32-bit floating point representation, a default real number would likely return 24. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function --- 3159,3176 ---- @node DIGITS ! @section @code{DIGITS} --- Significant binary digits function @fnindex DIGITS @cindex model representation, significant digits @table @asis @item @emph{Description}: ! @code{DIGITS(X)} returns the number of significant binary digits of the internal ! model representation of @var{X}. For example, on a system using a 32-bit floating point representation, a default real number would likely return 24. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Inquiry function *************** Inquiry function *** 3100,3106 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type may be @code{INTEGER(*)} or @code{REAL(*)}. @end multitable @item @emph{Return value}: --- 3180,3186 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type may be @code{INTEGER} or @code{REAL}. @end multitable @item @emph{Return value}: *************** end program test_digits *** 3134,3140 **** otherwise returns zero. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 3214,3220 ---- otherwise returns zero. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 3144,3155 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{INTEGER(*)} or @code{REAL(*)} @item @var{Y} @tab The type shall be the same type and kind as @var{X}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER(*)} or @code{REAL(*)}. @item @emph{Example}: @smallexample --- 3224,3235 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{INTEGER} or @code{REAL} @item @var{Y} @tab The type shall be the same type and kind as @var{X}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER} or @code{REAL}. @item @emph{Example}: @smallexample *************** end program test_dim *** 3166,3173 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{IDIM(X,Y)} @tab @code{INTEGER(4) X,Y} @tab @code{INTEGER(4)} @tab F77 and later ! @item @code{DDIM(X,Y)} @tab @code{REAL(8) X,Y} @tab @code{REAL(8)} @tab F77 and later @end multitable @end table --- 3246,3253 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{IDIM(X,Y)} @tab @code{INTEGER(4) X,Y} @tab @code{INTEGER(4)} @tab Fortran 77 and later ! @item @code{DDIM(X,Y)} @tab @code{REAL(8) X,Y} @tab @code{REAL(8)} @tab Fortran 77 and later @end multitable @end table *************** end program test_dim *** 3182,3212 **** @table @asis @item @emph{Description}: ! @code{DOT_PRODUCT(X,Y)} computes the dot product multiplication of two vectors ! @var{X} and @var{Y}. The two vectors may be either numeric or logical ! and must be arrays of rank one and of equal size. If the vectors are ! @code{INTEGER(*)} or @code{REAL(*)}, the result is @code{SUM(X*Y)}. If the ! vectors are @code{COMPLEX(*)}, the result is @code{SUM(CONJG(X)*Y)}. If the ! vectors are @code{LOGICAL}, the result is @code{ANY(X.AND.Y)}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function @item @emph{Syntax}: ! @code{RESULT = DOT_PRODUCT(X, Y)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be numeric or @code{LOGICAL}, rank 1. ! @item @var{Y} @tab The type shall be numeric or @code{LOGICAL}, rank 1. @end multitable @item @emph{Return value}: ! If the arguments are numeric, the return value is a scaler of numeric type, ! @code{INTEGER(*)}, @code{REAL(*)}, or @code{COMPLEX(*)}. If the arguments are @code{LOGICAL}, the return value is @code{.TRUE.} or @code{.FALSE.}. @item @emph{Example}: --- 3262,3293 ---- @table @asis @item @emph{Description}: ! @code{DOT_PRODUCT(VECTOR_A, VECTOR_B)} computes the dot product multiplication ! of two vectors @var{VECTOR_A} and @var{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 @code{INTEGER} or @code{REAL}, the result is ! @code{SUM(VECTOR_A*VECTOR_B)}. If the vectors are @code{COMPLEX}, the result ! is @code{SUM(CONJG(VECTOR_A)*VECTOR_B)}. If the vectors are @code{LOGICAL}, ! the result is @code{ANY(VECTOR_A .AND. VECTOR_B)}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function @item @emph{Syntax}: ! @code{RESULT = DOT_PRODUCT(VECTOR_A, VECTOR_B)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{VECTOR_A} @tab The type shall be numeric or @code{LOGICAL}, rank 1. ! @item @var{VECTOR_B} @tab The type shall be numeric if @var{VECTOR_A} is of numeric type or @code{LOGICAL} if @var{VECTOR_A} is of type @code{LOGICAL}. @var{VECTOR_B} shall be a rank-one array. @end multitable @item @emph{Return value}: ! If the arguments are numeric, the return value is a scalar of numeric type, ! @code{INTEGER}, @code{REAL}, or @code{COMPLEX}. If the arguments are @code{LOGICAL}, the return value is @code{.TRUE.} or @code{.FALSE.}. @item @emph{Example}: *************** end program test_dot_prod *** 3236,3242 **** @code{DPROD(X,Y)} returns the product @code{X*Y}. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 3317,3323 ---- @code{DPROD(X,Y)} returns the product @code{X*Y}. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** GNU extension *** 3283,3293 **** Elemental function @item @emph{Syntax}: ! @code{RESULT = DREAL(Z)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{Z} @tab The type shall be @code{COMPLEX(8)}. @end multitable @item @emph{Return value}: --- 3364,3374 ---- Elemental function @item @emph{Syntax}: ! @code{RESULT = DREAL(A)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A} @tab The type shall be @code{COMPLEX(8)}. @end multitable @item @emph{Return value}: *************** become, negative, or numerically less th *** 3332,3338 **** 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 @code{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 @code{CPU_TIME} instead. --- 3413,3419 ---- 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 @code{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 @code{CPU_TIME} instead. *************** end program test_dtime *** 3404,3412 **** @table @asis @item @emph{Description}: ! @code{EOSHIFT(ARRAY, SHIFT[,BOUNDARY, DIM])} performs an end-off shift on elements of @var{ARRAY} along the dimension of @var{DIM}. If @var{DIM} is ! omitted it is taken to be @code{1}. @var{DIM} is a scaler of type @code{INTEGER} in the range of @math{1 /leq DIM /leq n)} where @math{n} is the rank of @var{ARRAY}. If the rank of @var{ARRAY} is one, then all elements of @var{ARRAY} are shifted by @var{SHIFT} places. If rank is greater than one, --- 3485,3493 ---- @table @asis @item @emph{Description}: ! @code{EOSHIFT(ARRAY, SHIFT[, BOUNDARY, DIM])} performs an end-off shift on elements of @var{ARRAY} along the dimension of @var{DIM}. If @var{DIM} is ! omitted it is taken to be @code{1}. @var{DIM} is a scalar of type @code{INTEGER} in the range of @math{1 /leq DIM /leq n)} where @math{n} is the rank of @var{ARRAY}. If the rank of @var{ARRAY} is one, then all elements of @var{ARRAY} are shifted by @var{SHIFT} places. If rank is greater than one, *************** following are copied in depending on the *** 3424,3430 **** @end multitable @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 3505,3511 ---- @end multitable @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Transformational function *** 3434,3440 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{ARRAY} @tab May be any type, not scaler. @item @var{SHIFT} @tab The type shall be @code{INTEGER}. @item @var{BOUNDARY} @tab Same type as @var{ARRAY}. @item @var{DIM} @tab The type shall be @code{INTEGER}. --- 3515,3521 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{ARRAY} @tab May be any type, not scalar. @item @var{SHIFT} @tab The type shall be @code{INTEGER}. @item @var{BOUNDARY} @tab Same type as @var{ARRAY}. @item @var{DIM} @tab The type shall be @code{INTEGER}. *************** end program test_eoshift *** 3469,3478 **** @table @asis @item @emph{Description}: ! @code{EPSILON(X)} returns a nearly negligible number relative to @code{1}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function --- 3550,3560 ---- @table @asis @item @emph{Description}: ! @code{EPSILON(X)} returns the smallest number @var{E} of the same kind ! as @var{X} such that @math{1 + E > 1}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Inquiry function *************** Inquiry function *** 3482,3488 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}. @end multitable @item @emph{Return value}: --- 3564,3570 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL}. @end multitable @item @emph{Return value}: *************** end program test_epsilon *** 3511,3517 **** @code{ERF(X)} computes the error function of @var{X}. @item @emph{Standard}: ! GNU Extension @item @emph{Class}: Elemental function --- 3593,3599 ---- @code{ERF(X)} computes the error function of @var{X}. @item @emph{Standard}: ! Fortran 2008 and later @item @emph{Class}: Elemental function *************** Elemental function *** 3521,3532 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}, and it shall be scalar. @end multitable @item @emph{Return value}: ! The return value is a scalar of type @code{REAL(*)} and it is positive ! (@math{ - 1 \leq erf (x) \leq 1 }. @item @emph{Example}: @smallexample --- 3603,3614 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL}. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL}, of the same kind as ! @var{X} and lies in the range @math{-1 \leq erf (x) \leq 1 }. @item @emph{Example}: @smallexample *************** end program test_erf *** 3555,3561 **** @code{ERFC(X)} computes the complementary error function of @var{X}. @item @emph{Standard}: ! GNU extension @item @emph{Class}: Elemental function --- 3637,3643 ---- @code{ERFC(X)} computes the complementary error function of @var{X}. @item @emph{Standard}: ! Fortran 2008 and later @item @emph{Class}: Elemental function *************** Elemental function *** 3565,3576 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}, and it shall be scalar. @end multitable @item @emph{Return value}: ! The return value is a scalar of type @code{REAL(*)} and it is positive ! (@math{ 0 \leq erfc (x) \leq 2 }. @item @emph{Example}: @smallexample --- 3647,3658 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL}. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL} and of the same kind as @var{X}. ! It lies in the range @math{ 0 \leq erfc (x) \leq 2 }. @item @emph{Example}: @smallexample *************** end program test_erfc *** 3589,3594 **** --- 3671,3714 ---- + @node ERFC_SCALED + @section @code{ERFC_SCALED} --- Error function + @fnindex ERFC_SCALED + @cindex error function, complementary, exponentially-scaled + + @table @asis + @item @emph{Description}: + @code{ERFC_SCALED(X)} computes the exponentially-scaled complementary + error function of @var{X}. + + @item @emph{Standard}: + Fortran 2008 and later + + @item @emph{Class}: + Elemental function + + @item @emph{Syntax}: + @code{RESULT = ERFC_SCALED(X)} + + @item @emph{Arguments}: + @multitable @columnfractions .15 .70 + @item @var{X} @tab The type shall be @code{REAL}. + @end multitable + + @item @emph{Return value}: + The return value is of type @code{REAL} and of the same kind as @var{X}. + + @item @emph{Example}: + @smallexample + program test_erfc_scaled + real(8) :: x = 0.17_8 + x = erfc_scaled(x) + end program test_erfc_scaled + @end smallexample + @end table + + + @node ETIME @section @code{ETIME} --- Execution time subroutine (or function) @fnindex ETIME *************** end program test_exit *** 3725,3731 **** @code{EXP(X)} computes the base @math{e} exponential of @var{X}. @item @emph{Standard}: ! F77 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function --- 3845,3851 ---- @code{EXP(X)} computes the base @math{e} exponential of @var{X}. @item @emph{Standard}: ! Fortran 77 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function *************** Elemental function *** 3735,3742 **** @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}: --- 3855,3862 ---- @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}: *************** end program test_exp *** 3753,3760 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DEXP(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab F77 and later ! @item @code{CEXP(X)} @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab F77 and later @item @code{ZEXP(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension @item @code{CDEXP(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension @end multitable --- 3873,3880 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DEXP(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later ! @item @code{CEXP(X)} @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab Fortran 77 and later @item @code{ZEXP(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension @item @code{CDEXP(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension @end multitable *************** end program test_exp *** 3774,3780 **** is zero the value returned is zero. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 3894,3900 ---- is zero the value returned is zero. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** Elemental function *** 3784,3790 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}. @end multitable @item @emph{Return value}: --- 3904,3910 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL}. @end multitable @item @emph{Return value}: *************** TIME())}. *** 3821,3827 **** This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. ! @var{DATE} is an @code{INTENT(OUT)} @code{CHARACTER} variable. @item @emph{Standard}: GNU extension --- 3941,3948 ---- This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. ! @var{DATE} is an @code{INTENT(OUT)} @code{CHARACTER} variable of the ! default kind. @item @emph{Standard}: GNU extension *************** Subroutine, function *** 3837,3843 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{DATE}@tab The type shall be of type @code{CHARACTER}. @end multitable @item @emph{Return value}: --- 3958,3965 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{DATE}@tab The type shall be of type @code{CHARACTER} of the ! default kind @end multitable @item @emph{Return value}: *************** end program test_fdate *** 3868,3887 **** @table @asis @item @emph{Description}: ! @code{FLOAT(I)} converts the integer @var{I} to a default real value. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = FLOAT(I)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER(*)}. @end multitable @item @emph{Return value}: --- 3990,4009 ---- @table @asis @item @emph{Description}: ! @code{FLOAT(A)} converts the integer @var{A} to a default real value. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = FLOAT(A)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A} @tab The type shall be @code{INTEGER}. @end multitable @item @emph{Return value}: *************** Subroutine, function *** 3933,3942 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{C} @tab The type shall be @code{CHARACTER}. @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}. ! Returns 0 on success, -1 on end-of-file, and a ! system specific positive error code otherwise. @end multitable @item @emph{Example}: --- 4055,4065 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{C} @tab The type shall be @code{CHARACTER} and of default ! kind. @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}. ! Returns 0 on success, -1 on end-of-file, and a system specific positive ! error code otherwise. @end multitable @item @emph{Example}: *************** Subroutine, function *** 3995,4003 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{UNIT} @tab The type shall be @code{INTEGER}. ! @item @var{C} @tab The type shall be @code{CHARACTER}. ! @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}. Returns 0 on success, ! -1 on end-of-file and a system specific positive error code otherwise. @end multitable @item @emph{Example}: --- 4118,4128 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{UNIT} @tab The type shall be @code{INTEGER}. ! @item @var{C} @tab The type shall be @code{CHARACTER} and of default ! kind. ! @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}. ! Returns 0 on success, -1 on end-of-file and a system specific positive ! error code otherwise. @end multitable @item @emph{Example}: *************** END PROGRAM *** 4030,4056 **** @table @asis @item @emph{Description}: ! @code{FLOOR(X)} returns the greatest integer less than or equal to @var{X}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = FLOOR(X [, KIND])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER(*)} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER(KIND)} @item @emph{Example}: @smallexample --- 4155,4181 ---- @table @asis @item @emph{Description}: ! @code{FLOOR(A)} returns the greatest integer less than or equal to @var{X}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = FLOOR(A [, KIND])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A} @tab The type shall be @code{REAL}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER(KIND)} if @var{KIND} is present ! and of default-kind @code{INTEGER} otherwise. @item @emph{Example}: @smallexample *************** Subroutine, function *** 4174,4182 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{C} @tab The type shall be @code{CHARACTER}. ! @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}. Returns 0 on success, ! -1 on end-of-file and a system specific positive error code otherwise. @end multitable @item @emph{Example}: --- 4299,4309 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{C} @tab The type shall be @code{CHARACTER} and of default ! kind. ! @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}. ! Returns 0 on success, -1 on end-of-file and a system specific positive ! error code otherwise. @end multitable @item @emph{Example}: *************** Subroutine, function *** 4229,4237 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{UNIT} @tab The type shall be @code{INTEGER}. ! @item @var{C} @tab The type shall be @code{CHARACTER}. ! @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}. Returns 0 on success, ! -1 on end-of-file and a system specific positive error code otherwise. @end multitable @item @emph{Example}: --- 4356,4366 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{UNIT} @tab The type shall be @code{INTEGER}. ! @item @var{C} @tab The type shall be @code{CHARACTER} and of default ! kind. ! @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}. ! Returns 0 on success, -1 on end-of-file and a system specific positive ! error code otherwise. @end multitable @item @emph{Example}: *************** END PROGRAM *** 4266,4272 **** representation of @code{X}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 4395,4401 ---- representation of @code{X}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** Subroutine, function *** 4447,4453 **** @item @var{UNIT} @tab An open I/O unit number of type @code{INTEGER}. @item @var{BUFF} @tab The type shall be @code{INTEGER(4), DIMENSION(13)}. @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)}. Returns 0 ! on success and a system specific error code otherwise. @end multitable @item @emph{Example}: --- 4576,4582 ---- @item @var{UNIT} @tab An open I/O unit number of type @code{INTEGER}. @item @var{BUFF} @tab The type shall be @code{INTEGER(4), DIMENSION(13)}. @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)}. Returns 0 ! on success and a system specific error code otherwise. @end multitable @item @emph{Example}: *************** $$ *** 4529,4535 **** @end tex @item @emph{Standard}: ! GNU Extension @item @emph{Class}: Elemental function --- 4658,4664 ---- @end tex @item @emph{Standard}: ! Fortran 2008 and later @item @emph{Class}: Elemental function *************** end program test_gamma *** 4562,4568 **** @end multitable @item @emph{See also}: ! Logarithm of the Gamma function: @ref{LGAMMA} @end table --- 4691,4697 ---- @end multitable @item @emph{See also}: ! Logarithm of the Gamma function: @ref{LOG_GAMMA} @end table *************** Subroutine *** 4589,4595 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{RESULT} @tab Shall of type @code{CHARACTER(*)}. @end multitable @item @emph{Example}: --- 4718,4724 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{RESULT} @tab Shall of type @code{CHARACTER} and of default @end multitable @item @emph{Example}: *************** END PROGRAM *** 4615,4621 **** @table @asis @item @emph{Description}: ! Retrieve the @var{N}th argument that was passed on the command line when the containing program was invoked. This intrinsic routine is provided for backwards compatibility with --- 4744,4750 ---- @table @asis @item @emph{Description}: ! Retrieve the @var{POS}-th argument that was passed on the command line when the containing program was invoked. This intrinsic routine is provided for backwards compatibility with *************** Subroutine *** 4636,4642 **** @multitable @columnfractions .15 .70 @item @var{POS} @tab Shall be of type @code{INTEGER} and not wider than the default integer kind; @math{@var{POS} \geq 0} ! @item @var{VALUE} @tab Shall be of type @code{CHARACTER(*)}. @end multitable @item @emph{Return value}: --- 4765,4773 ---- @multitable @columnfractions .15 .70 @item @var{POS} @tab Shall be of type @code{INTEGER} and not wider than the default integer kind; @math{@var{POS} \geq 0} ! @item @var{VALUE} @tab Shall be of type @code{CHARACTER} and of default ! kind. ! @item @var{VALUE} @tab Shall be of type @code{CHARACTER}. @end multitable @item @emph{Return value}: *************** END PROGRAM *** 4663,4670 **** @item @emph{See also}: GNU Fortran 77 compatibility function: @ref{IARGC} ! F2003 functions and subroutines: @ref{GET_COMMAND}, @ref{GET_COMMAND_ARGUMENT}, ! @ref{COMMAND_ARGUMENT_COUNT} @end table --- 4794,4801 ---- @item @emph{See also}: GNU Fortran 77 compatibility function: @ref{IARGC} ! Fortran 2003 functions and subroutines: @ref{GET_COMMAND}, ! @ref{GET_COMMAND_ARGUMENT}, @ref{COMMAND_ARGUMENT_COUNT} @end table *************** F2003 functions and subroutines: @ref{GE *** 4680,4701 **** Retrieve the entire command line that was used to invoke the program. @item @emph{Standard}: ! F2003 @item @emph{Class}: Subroutine @item @emph{Syntax}: ! @code{CALL GET_COMMAND(CMD)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{CMD} @tab Shall be of type @code{CHARACTER(*)}. @end multitable @item @emph{Return value}: ! Stores the entire command line that was used to invoke the program in @var{ARG}. ! If @var{ARG} is not large enough, the command will be truncated. @item @emph{Example}: @smallexample --- 4811,4834 ---- Retrieve the entire command line that was used to invoke the program. @item @emph{Standard}: ! Fortran 2003 and later @item @emph{Class}: Subroutine @item @emph{Syntax}: ! @code{CALL GET_COMMAND(COMMAND)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{COMMAND} @tab Shall be of type @code{CHARACTER} and of default ! kind. @end multitable @item @emph{Return value}: ! Stores the entire command line that was used to invoke the program in ! @var{COMMAND}. If @var{COMMAND} is not large enough, the command will be ! truncated. @item @emph{Example}: @smallexample *************** END PROGRAM *** 4720,4750 **** @table @asis @item @emph{Description}: ! Retrieve the @var{N}th argument that was passed on the command line when the containing program was invoked. @item @emph{Standard}: ! F2003 @item @emph{Class}: Subroutine @item @emph{Syntax}: ! @code{CALL GET_COMMAND_ARGUMENT(N, ARG)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{N} @tab Shall be of type @code{INTEGER(4)}, @math{@var{N} \geq 0} ! @item @var{ARG} @tab Shall be of type @code{CHARACTER(*)}. @end multitable @item @emph{Return value}: ! After @code{GET_COMMAND_ARGUMENT} returns, the @var{ARG} argument holds the ! @var{N}th command line argument. If @var{ARG} can not hold the argument, it is ! truncated to fit the length of @var{ARG}. If there are less than @var{N} ! arguments specified at the command line, @var{ARG} will be filled with blanks. ! If @math{@var{N} = 0}, @var{ARG} is set to the name of the program (on systems ! that support this feature). @item @emph{Example}: @smallexample --- 4853,4891 ---- @table @asis @item @emph{Description}: ! Retrieve the @var{NUMBER}-th argument that was passed on the command line when the containing program was invoked. @item @emph{Standard}: ! Fortran 2003 and later @item @emph{Class}: Subroutine @item @emph{Syntax}: ! @code{CALL GET_COMMAND_ARGUMENT(NUMBER [, VALUE, LENGTH, STATUS])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{NUMBER} @tab Shall be a scalar of type @code{INTEGER(4)}, ! @math{@var{NUMBER} \geq 0} ! @item @var{VALUE} @tab Shall be a scalar of type @code{CHARACTER} ! and of default kind. ! @item @var{LENGTH} @tab (Option) Shall be a scalar of type @code{INTEGER(4)}. ! @item @var{STATUS} @tab (Option) Shall be a scalar of type @code{INTEGER(4)}. @end multitable @item @emph{Return value}: ! After @code{GET_COMMAND_ARGUMENT} returns, the @var{VALUE} argument holds the ! @var{NUMBER}-th command line argument. If @var{VALUE} can not hold the argument, it is ! truncated to fit the length of @var{VALUE}. If there are less than @var{NUMBER} ! arguments specified at the command line, @var{VALUE} will be filled with blanks. ! If @math{@var{NUMBER} = 0}, @var{VALUE} is set to the name of the program (on ! systems that support this feature). The @var{LENGTH} argument contains the ! length of the @var{NUMBER}-th command line argument. If the argument retrieval ! fails, @var{STATUS} is a positive number; if @var{VALUE} contains a truncated ! command line argument, @var{STATUS} is -1; and otherwise the @var{STATUS} is ! zero. @item @emph{Example}: @smallexample *************** GNU extension *** 4788,4800 **** Subroutine, function @item @emph{Syntax}: ! @code{CALL GETCWD(CWD [, STATUS])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{CWD} @tab The type shall be @code{CHARACTER(*)}. @item @var{STATUS} @tab (Optional) status flag. Returns 0 on success, ! a system specific and nonzero error code otherwise. @end multitable @item @emph{Example}: --- 4929,4941 ---- Subroutine, function @item @emph{Syntax}: ! @code{CALL GETCWD(C [, STATUS])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{C} @tab The type shall be @code{CHARACTER} and of default kind. @item @var{STATUS} @tab (Optional) status flag. Returns 0 on success, ! a system specific and nonzero error code otherwise. @end multitable @item @emph{Example}: *************** END PROGRAM *** 4819,4825 **** @table @asis @item @emph{Description}: ! Get the @var{VALUE} of the environmental variable @var{ENVVAR}. This intrinsic routine is provided for backwards compatibility with GNU Fortran 77. In new code, programmers should consider the use of --- 4960,4966 ---- @table @asis @item @emph{Description}: ! Get the @var{VALUE} of the environmental variable @var{NAME}. This intrinsic routine is provided for backwards compatibility with GNU Fortran 77. In new code, programmers should consider the use of *************** GNU extension *** 4833,4849 **** Subroutine @item @emph{Syntax}: ! @code{CALL GETENV(ENVVAR, VALUE)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{ENVVAR} @tab Shall be of type @code{CHARACTER(*)}. ! @item @var{VALUE} @tab Shall be of type @code{CHARACTER(*)}. @end multitable @item @emph{Return value}: ! Stores the value of @var{ENVVAR} in @var{VALUE}. If @var{VALUE} is ! not large enough to hold the data, it is truncated. If @var{ENVVAR} is not set, @var{VALUE} will be filled with blanks. @item @emph{Example}: --- 4974,4990 ---- Subroutine @item @emph{Syntax}: ! @code{CALL GETENV(NAME, VALUE)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{NAME} @tab Shall be of type @code{CHARACTER} and of default kind. ! @item @var{VALUE} @tab Shall be of type @code{CHARACTER} and of default kind. @end multitable @item @emph{Return value}: ! Stores the value of @var{NAME} in @var{VALUE}. If @var{VALUE} is ! not large enough to hold the data, it is truncated. If @var{NAME} is not set, @var{VALUE} will be filled with blanks. @item @emph{Example}: *************** END PROGRAM *** 4868,4894 **** @table @asis @item @emph{Description}: ! Get the @var{VALUE} of the environmental variable @var{ENVVAR}. @item @emph{Standard}: ! F2003 @item @emph{Class}: Subroutine @item @emph{Syntax}: ! @code{CALL GET_ENVIRONMENT_VARIABLE(ENVVAR, VALUE)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{ENVVAR} @tab Shall be of type @code{CHARACTER(*)}. ! @item @var{VALUE} @tab Shall be of type @code{CHARACTER(*)}. @end multitable @item @emph{Return value}: ! Stores the value of @var{ENVVAR} in @var{VALUE}. If @var{VALUE} is ! not large enough to hold the data, it is truncated. If @var{ENVVAR} ! is not set, @var{VALUE} will be filled with blanks. @item @emph{Example}: @smallexample --- 5009,5046 ---- @table @asis @item @emph{Description}: ! Get the @var{VALUE} of the environmental variable @var{NAME}. @item @emph{Standard}: ! Fortran 2003 and later @item @emph{Class}: Subroutine @item @emph{Syntax}: ! @code{CALL GET_ENVIRONMENT_VARIABLE(NAME[, VALUE, LENGTH, STATUS, TRIM_NAME)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{NAME} @tab Shall be a scalar of type @code{CHARACTER(1)}. ! @item @var{VALUE} @tab Shall be a scalar of type @code{CHARACTER(1)}. ! @item @var{LENGTH} @tab Shall be a scalar of type @code{INTEGER(4)}. ! @item @var{STATUS} @tab Shall be a scalar of type @code{INTEGER(4)}. ! @item @var{TRIM_NAME} @tab Shall be a scalar of type @code{LOGICAL(4)}. @end multitable @item @emph{Return value}: ! Stores the value of @var{NAME} in @var{VALUE}. If @var{VALUE} is ! not large enough to hold the data, it is truncated. If @var{NAME} ! is not set, @var{VALUE} will be filled with blanks. Argument @var{LENGTH} ! contains the length needed for storing the environment variable @var{NAME} ! or zero if it is not present. @var{STATUS} is -1 if @var{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 @var{STATUS} is zero. If @var{TRIM_NAME} is ! present with the value @code{.FALSE.}, the trailing blanks in @var{NAME} ! are significant; otherwise they are not part of the environment variable ! name. @item @emph{Example}: @smallexample *************** GNU extension *** 4951,4961 **** Subroutine @item @emph{Syntax}: ! @code{CALL GETLOG(LOGIN)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{LOGIN} @tab Shall be of type @code{CHARACTER(*)}. @end multitable @item @emph{Return value}: --- 5103,5113 ---- Subroutine @item @emph{Syntax}: ! @code{CALL GETLOG(C)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{C} @tab Shall be of type @code{CHARACTER} and of default kind. @end multitable @item @emph{Return value}: *************** See @code{GETPID} for an example. *** 5058,5065 **** @table @asis @item @emph{Description}: ! Given a system time value @var{STIME} (as provided by the @code{TIME8()} ! intrinsic), fills @var{TARRAY} 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)}. --- 5210,5217 ---- @table @asis @item @emph{Description}: ! Given a system time value @var{TIME} (as provided by the @code{TIME8()} ! 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)}. *************** GNU extension *** 5070,5091 **** Subroutine @item @emph{Syntax}: ! @code{CALL GMTIME(STIME, TARRAY)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STIME} @tab An @code{INTEGER(*)} scalar expression ! corresponding to a system time, with ! @code{INTENT(IN)}. ! @item @var{TARRAY} @tab A default @code{INTEGER} array with 9 elements, ! with @code{INTENT(OUT)}. @end multitable @item @emph{Return value}: ! The elements of @var{TARRAY} are assigned as follows: @enumerate @item Seconds after the minute, range 0--59 or 0--61 to allow for leap ! seconds @item Minutes after the hour, range 0--59 @item Hours past midnight, range 0--23 @item Day of month, range 0--31 --- 5222,5242 ---- Subroutine @item @emph{Syntax}: ! @code{CALL GMTIME(TIME, VALUES)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{TIME} @tab An @code{INTEGER} scalar expression ! corresponding to a system time, with @code{INTENT(IN)}. ! @item @var{VALUES} @tab A default @code{INTEGER} array with 9 elements, ! with @code{INTENT(OUT)}. @end multitable @item @emph{Return value}: ! The elements of @var{VALUES} are assigned as follows: @enumerate @item Seconds after the minute, range 0--59 or 0--61 to allow for leap ! seconds @item Minutes after the hour, range 0--59 @item Hours past midnight, range 0--23 @item Day of month, range 0--31 *************** The elements of @var{TARRAY} are assigne *** 5094,5101 **** @item Number of days since Sunday, range 0--6 @item Days since January 1 @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}: --- 5245,5251 ---- @item Number of days since Sunday, range 0--6 @item Days since January 1 @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}: *************** Subroutine, function *** 5125,5140 **** @item @emph{Syntax}: @multitable @columnfractions .80 ! @item @code{CALL HOSTNM(NAME[, STATUS])} @item @code{STATUS = HOSTNM(NAME)} @end multitable @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{NAME} @tab Shall of type @code{CHARACTER(*)}. @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}. ! Returns 0 on success, or a system specific error ! code otherwise. @end multitable @item @emph{Return value}: --- 5275,5289 ---- @item @emph{Syntax}: @multitable @columnfractions .80 ! @item @code{CALL HOSTNM(C [, STATUS])} @item @code{STATUS = HOSTNM(NAME)} @end multitable @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{C} @tab Shall of type @code{CHARACTER} and of default kind. @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}. ! Returns 0 on success, or a system specific error code otherwise. @end multitable @item @emph{Return value}: *************** be obtained, or to a blank string otherw *** 5157,5163 **** the model of the type of @code{X}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function --- 5306,5312 ---- the model of the type of @code{X}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Inquiry function *************** end program test_huge_tiny *** 5184,5189 **** --- 5333,5378 ---- + @node HYPOT + @section @code{HYPOT} --- Euclidean distance function + @fnindex HYPOT + @cindex Euclidean distance + + @table @asis + @item @emph{Description}: + @code{HYPOT(X,Y)} is the Euclidean distance function. It is equal to + @math{\sqrt{X^2 + Y^2}}, without undue underflow or overflow. + + @item @emph{Standard}: + Fortran 2008 and later + + @item @emph{Class}: + Elemental function + + @item @emph{Syntax}: + @code{RESULT = HYPOT(X, Y)} + + @item @emph{Arguments}: + @multitable @columnfractions .15 .70 + @item @var{X} @tab The type shall be @code{REAL}. + @item @var{Y} @tab The type and kind type parameter shall be the same as + @var{X}. + @end multitable + + @item @emph{Return value}: + The return value has the same type and kind type parameter as @var{X}. + + @item @emph{Example}: + @smallexample + program test_hypot + real(4) :: x = 1.e0_4, y = 0.5e0_4 + x = hypot(x,y) + end program test_hypot + @end smallexample + @end table + + + @node IACHAR @section @code{IACHAR} --- Code in @acronym{ASCII} collating sequence @fnindex IACHAR *************** end program test_huge_tiny *** 5197,5203 **** in the first character position of @code{C}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 5386,5392 ---- in the first character position of @code{C}. @item @emph{Standard}: ! Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later @item @emph{Class}: Elemental function *************** Elemental function *** 5209,5216 **** @multitable @columnfractions .15 .70 @item @var{C} @tab Shall be a scalar @code{CHARACTER}, with @code{INTENT(IN)} @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: --- 5398,5404 ---- @multitable @columnfractions .15 .70 @item @var{C} @tab Shall be a scalar @code{CHARACTER}, with @code{INTENT(IN)} @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: *************** and formatted string representations. *** 5247,5253 **** Bitwise logical @code{AND}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 5435,5441 ---- Bitwise logical @code{AND}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** Elemental function *** 5257,5270 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER(*)}. ! @item @var{J} @tab The type shall be @code{INTEGER(*)}, of the same kind as @var{I}. (As a GNU extension, different kinds are also permitted.) @end multitable @item @emph{Return value}: ! 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.) --- 5445,5458 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER}. ! @item @var{J} @tab The type shall be @code{INTEGER}, of the same kind as @var{I}. (As a GNU extension, different kinds are also permitted.) @end multitable @item @emph{Return value}: ! 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.) *************** See @ref{GETARG} *** 5322,5329 **** @item @emph{See also}: GNU Fortran 77 compatibility subroutine: @ref{GETARG} ! F2003 functions and subroutines: @ref{GET_COMMAND}, @ref{GET_COMMAND_ARGUMENT}, ! @ref{COMMAND_ARGUMENT_COUNT} @end table --- 5510,5517 ---- @item @emph{See also}: GNU Fortran 77 compatibility subroutine: @ref{GETARG} ! Fortran 2003 functions and subroutines: @ref{GET_COMMAND}, ! @ref{GET_COMMAND_ARGUMENT}, @ref{COMMAND_ARGUMENT_COUNT} @end table *************** F2003 functions and subroutines: @ref{GE *** 5340,5346 **** @var{POS} set to zero. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 5528,5534 ---- @var{POS} set to zero. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** Elemental function *** 5350,5361 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER(*)}. ! @item @var{POS} @tab The type shall be @code{INTEGER(*)}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER(*)} and of the same kind as @var{I}. @item @emph{See also}: --- 5538,5549 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER}. ! @item @var{POS} @tab The type shall be @code{INTEGER}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER} and of the same kind as @var{I}. @item @emph{See also}: *************** zeroed. The value of @code{POS+LEN} mus *** 5380,5386 **** value @code{BIT_SIZE(I)}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 5568,5574 ---- value @code{BIT_SIZE(I)}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** Elemental function *** 5390,5402 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER(*)}. ! @item @var{POS} @tab The type shall be @code{INTEGER(*)}. ! @item @var{LEN} @tab The type shall be @code{INTEGER(*)}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER(*)} and of the same kind as @var{I}. @item @emph{See also}: --- 5578,5590 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER}. ! @item @var{POS} @tab The type shall be @code{INTEGER}. ! @item @var{LEN} @tab The type shall be @code{INTEGER}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER} and of the same kind as @var{I}. @item @emph{See also}: *************** The return value is of type @code{INTEGE *** 5416,5422 **** @var{POS} set to one. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 5604,5610 ---- @var{POS} set to one. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** Elemental function *** 5426,5437 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER(*)}. ! @item @var{POS} @tab The type shall be @code{INTEGER(*)}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER(*)} and of the same kind as @var{I}. @item @emph{See also}: --- 5614,5625 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER}. ! @item @var{POS} @tab The type shall be @code{INTEGER}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER} and of the same kind as @var{I}. @item @emph{See also}: *************** The correspondence between characters an *** 5454,5460 **** the same across different GNU Fortran implementations. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 5642,5648 ---- the same across different GNU Fortran implementations. @item @emph{Standard}: ! Fortan 95 and later, with @var{KIND} argument Fortran 2003 and later @item @emph{Class}: Elemental function *************** Elemental function *** 5466,5473 **** @multitable @columnfractions .15 .70 @item @var{C} @tab Shall be a scalar @code{CHARACTER}, with @code{INTENT(IN)} @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: --- 5654,5660 ---- @multitable @columnfractions .15 .70 @item @var{C} @tab Shall be a scalar @code{CHARACTER}, with @code{INTENT(IN)} @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: *************** GNU extension *** 5532,5547 **** Subroutine @item @emph{Syntax}: ! @code{CALL IDATE(TARRAY)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{TARRAY} @tab The type shall be @code{INTEGER, DIMENSION(3)} and the kind shall be the default integer kind. @end multitable @item @emph{Return value}: ! Does not return. @item @emph{Example}: @smallexample --- 5719,5734 ---- Subroutine @item @emph{Syntax}: ! @code{CALL IDATE(VALUES)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{VALUES} @tab The type shall be @code{INTEGER, DIMENSION(3)} and the kind shall be the default integer kind. @end multitable @item @emph{Return value}: ! Does not return anything. @item @emph{Example}: @smallexample *************** end program test_idate *** 5569,5575 **** @var{J}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 5756,5762 ---- @var{J}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** Elemental function *** 5579,5592 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER(*)}. ! @item @var{J} @tab The type shall be @code{INTEGER(*)}, of the same kind as @var{I}. (As a GNU extension, different kinds are also permitted.) @end multitable @item @emph{Return value}: ! 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.) --- 5766,5779 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER}. ! @item @var{J} @tab The type shall be @code{INTEGER}, of the same kind as @var{I}. (As a GNU extension, different kinds are also permitted.) @end multitable @item @emph{Return value}: ! 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.) *************** the @var{BACK} argument is present and t *** 5643,5649 **** start of the last occurrence rather than the first. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 5830,5836 ---- start of the last occurrence rather than the first. @item @emph{Standard}: ! Fortran 77 and later, with @var{KIND} argument Fortran 2003 and later @item @emph{Class}: Elemental function *************** Elemental function *** 5653,5667 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STRING} @tab Shall be a scalar @code{CHARACTER(*)}, with @code{INTENT(IN)} ! @item @var{SUBSTRING} @tab Shall be a scalar @code{CHARACTER(*)}, with @code{INTENT(IN)} ! @item @var{BACK} @tab (Optional) Shall be a scalar @code{LOGICAL(*)}, with @code{INTENT(IN)} @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: --- 5840,5853 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STRING} @tab Shall be a scalar @code{CHARACTER}, with @code{INTENT(IN)} ! @item @var{SUBSTRING} @tab Shall be a scalar @code{CHARACTER}, with @code{INTENT(IN)} ! @item @var{BACK} @tab (Optional) Shall be a scalar @code{LOGICAL}, with @code{INTENT(IN)} @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: *************** The return value is of type @code{INTEGE *** 5686,5692 **** Convert to integer type @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 5872,5878 ---- Convert to integer type @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 5696,5721 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A} @tab Shall be of type @code{INTEGER(*)}, ! @code{REAL(*)}, or @code{COMPLEX(*)}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER(*)} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: ! These functions return a @code{INTEGER(*)} variable or array under the following rules: @table @asis @item (A) ! If @var{A} is of type @code{INTEGER(*)}, @code{INT(A) = A} @item (B) ! If @var{A} is of type @code{REAL(*)} and @math{|A| < 1}, @code{INT(A)} equals @code{0}. If @math{|A| \geq 1}, then @code{INT(A)} equals the largest integer that does not exceed the range of @var{A} and whose sign is the same as the sign of @var{A}. @item (C) ! If @var{A} is of type @code{COMPLEX(*)}, rule B is applied to the real part of @var{A}. @end table @item @emph{Example}: --- 5882,5906 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A} @tab Shall be of type @code{INTEGER}, ! @code{REAL}, or @code{COMPLEX}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: ! These functions return a @code{INTEGER} variable or array under the following rules: @table @asis @item (A) ! If @var{A} is of type @code{INTEGER}, @code{INT(A) = A} @item (B) ! If @var{A} is of type @code{REAL} and @math{|A| < 1}, @code{INT(A)} equals @code{0}. If @math{|A| \geq 1}, then @code{INT(A)} equals the largest integer that does not exceed the range of @var{A} and whose sign is the same as the sign of @var{A}. @item (C) ! If @var{A} is of type @code{COMPLEX}, rule B is applied to the real part of @var{A}. @end table @item @emph{Example}: *************** end program *** 5731,5738 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{IFIX(A)} @tab @code{REAL(4) A} @tab @code{INTEGER} @tab F77 and later ! @item @code{IDINT(A)} @tab @code{REAL(8) A} @tab @code{INTEGER} @tab F77 and later @end multitable @end table --- 5916,5923 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{IFIX(A)} @tab @code{REAL(4) A} @tab @code{INTEGER} @tab Fortran 77 and later ! @item @code{IDINT(A)} @tab @code{REAL(8) A} @tab @code{INTEGER} @tab Fortran 77 and later @end multitable @end table *************** standard @code{INT} intrinsic with an op *** 5754,5760 **** The @code{SHORT} intrinsic is equivalent to @code{INT2}. @item @emph{Standard}: ! GNU extension. @item @emph{Class}: Elemental function --- 5939,5945 ---- The @code{SHORT} intrinsic is equivalent to @code{INT2}. @item @emph{Standard}: ! GNU extension @item @emph{Class}: Elemental function *************** Elemental function *** 5764,5771 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A} @tab Shall be of type @code{INTEGER(*)}, ! @code{REAL(*)}, or @code{COMPLEX(*)}. @end multitable @item @emph{Return value}: --- 5949,5956 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A} @tab Shall be of type @code{INTEGER}, ! @code{REAL}, or @code{COMPLEX}. @end multitable @item @emph{Return value}: *************** standard @code{INT} intrinsic with an op *** 5789,5795 **** @code{KIND=8}, and is only included for backwards compatibility. @item @emph{Standard}: ! GNU extension. @item @emph{Class}: Elemental function --- 5974,5980 ---- @code{KIND=8}, and is only included for backwards compatibility. @item @emph{Standard}: ! GNU extension @item @emph{Class}: Elemental function *************** Elemental function *** 5799,5806 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A} @tab Shall be of type @code{INTEGER(*)}, ! @code{REAL(*)}, or @code{COMPLEX(*)}. @end multitable @item @emph{Return value}: --- 5984,5991 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A} @tab Shall be of type @code{INTEGER}, ! @code{REAL}, or @code{COMPLEX}. @end multitable @item @emph{Return value}: *************** The return value is a @code{INTEGER(8)} *** 5824,5830 **** @var{J}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 6009,6015 ---- @var{J}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** Elemental function *** 5834,5847 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER(*)}. ! @item @var{J} @tab The type shall be @code{INTEGER(*)}, of the same kind as @var{I}. (As a GNU extension, different kinds are also permitted.) @end multitable @item @emph{Return value}: ! 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.) --- 6019,6032 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER}. ! @item @var{J} @tab The type shall be @code{INTEGER}, of the same kind as @var{I}. (As a GNU extension, different kinds are also permitted.) @end multitable @item @emph{Return value}: ! 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.) *************** GNU extension *** 5877,5887 **** Function @item @emph{Syntax}: ! @code{RESULT = IRAND(FLAG)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{FLAG} @tab Shall be a scalar @code{INTEGER} of kind 4. @end multitable @item @emph{Return value}: --- 6062,6072 ---- Function @item @emph{Syntax}: ! @code{RESULT = IRAND(I)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab Shall be a scalar @code{INTEGER} of kind 4. @end multitable @item @emph{Return value}: *************** with the @code{IOSTAT_END} parameter of *** 5915,5921 **** @code{ISO_FORTRAN_ENV}. @item @emph{Standard}: ! Fortran 2003. @item @emph{Class}: Elemental function --- 6100,6106 ---- @code{ISO_FORTRAN_ENV}. @item @emph{Standard}: ! Fortran 2003 and later @item @emph{Class}: Elemental function *************** variable with the @code{IOSTAT_EOR} para *** 5960,5966 **** @code{ISO_FORTRAN_ENV}. @item @emph{Standard}: ! Fortran 2003. @item @emph{Class}: Elemental function --- 6145,6151 ---- @code{ISO_FORTRAN_ENV}. @item @emph{Standard}: ! Fortran 2003 and later @item @emph{Class}: Elemental function *************** END PROGRAM *** 6002,6008 **** Determine whether a unit is connected to a terminal device. @item @emph{Standard}: ! GNU extension. @item @emph{Class}: Function --- 6187,6193 ---- Determine whether a unit is connected to a terminal device. @item @emph{Standard}: ! GNU extension @item @emph{Class}: Function *************** Function *** 6012,6018 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{UNIT} @tab Shall be a scalar @code{INTEGER(*)}. @end multitable @item @emph{Return value}: --- 6197,6203 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{UNIT} @tab Shall be a scalar @code{INTEGER}. @end multitable @item @emph{Return value}: *************** value is undefined. Bits shifted out fr *** 6050,6056 **** lost; zeros are shifted in from the opposite end. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 6235,6241 ---- lost; zeros are shifted in from the opposite end. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** Elemental function *** 6060,6071 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER(*)}. ! @item @var{SHIFT} @tab The type shall be @code{INTEGER(*)}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER(*)} and of the same kind as @var{I}. @item @emph{See also}: --- 6245,6256 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER}. ! @item @var{SHIFT} @tab The type shall be @code{INTEGER}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER} and of the same kind as @var{I}. @item @emph{See also}: *************** a right shift. The absolute value of @v *** 6091,6097 **** equivalent to @code{BIT_SIZE(I)}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 6276,6282 ---- equivalent to @code{BIT_SIZE(I)}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** Elemental function *** 6101,6115 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER(*)}. ! @item @var{SHIFT} @tab The type shall be @code{INTEGER(*)}. ! @item @var{SIZE} @tab (Optional) The type shall be @code{INTEGER(*)}; the value must be greater than zero and less than or equal to @code{BIT_SIZE(I)}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER(*)} and of the same kind as @var{I}. @item @emph{See also}: --- 6286,6300 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER}. ! @item @var{SHIFT} @tab The type shall be @code{INTEGER}. ! @item @var{SIZE} @tab (Optional) The type shall be @code{INTEGER}; the value must be greater than zero and less than or equal to @code{BIT_SIZE(I)}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER} and of the same kind as @var{I}. @item @emph{See also}: *************** end program test_nan *** 6168,6176 **** @table @asis @item @emph{Description}: ! @code{IDATE(TARRAY)} Fills @var{TARRAY} 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{TARRAY}, respectively. @item @emph{Standard}: --- 6353,6361 ---- @table @asis @item @emph{Description}: ! @code{IDATE(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. @item @emph{Standard}: *************** GNU extension *** 6180,6195 **** Subroutine @item @emph{Syntax}: ! @code{CALL ITIME(TARRAY)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{TARRAY} @tab The type shall be @code{INTEGER, DIMENSION(3)} and the kind shall be the default integer kind. @end multitable @item @emph{Return value}: ! Does not return. @item @emph{Example}: --- 6365,6380 ---- Subroutine @item @emph{Syntax}: ! @code{CALL ITIME(VALUES)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{VALUES} @tab The type shall be @code{INTEGER, DIMENSION(3)} and the kind shall be the default integer kind. @end multitable @item @emph{Return value}: ! Does not return anything. @item @emph{Example}: *************** only one form can be used in any given p *** 6223,6239 **** Subroutine, function @item @emph{Syntax}: ! @code{CALL KILL(PID, SIGNAL [, STATUS])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{PID} @tab Shall be a scalar @code{INTEGER}, with @code{INTENT(IN)} ! @item @var{SIGNAL} @tab Shall be a scalar @code{INTEGER}, with @code{INTENT(IN)} @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)} or ! @code{INTEGER(8)}. Returns 0 on success, or a ! system-specific error code otherwise. @end multitable @item @emph{See also}: --- 6408,6424 ---- Subroutine, function @item @emph{Syntax}: ! @code{CALL KILL(C, VALUE [, STATUS])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{C} @tab Shall be a scalar @code{INTEGER}, with @code{INTENT(IN)} ! @item @var{VALUE} @tab Shall be a scalar @code{INTEGER}, with @code{INTENT(IN)} @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)} or ! @code{INTEGER(8)}. Returns 0 on success, or a system-specific error code ! otherwise. @end multitable @item @emph{See also}: *************** Subroutine, function *** 6252,6258 **** @code{KIND(X)} returns the kind value of the entity @var{X}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function --- 6437,6443 ---- @code{KIND(X)} returns the kind value of the entity @var{X}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Inquiry function *************** end program test_kind *** 6295,6301 **** Returns the lower bounds of an array, or a single lower bound along the @var{DIM} dimension. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function --- 6480,6486 ---- Returns the lower bounds of an array, or a single lower bound along the @var{DIM} dimension. @item @emph{Standard}: ! Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later @item @emph{Class}: Inquiry function *************** Inquiry function *** 6306,6315 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{ARRAY} @tab Shall be an array, of any type. ! @item @var{DIM} @tab (Optional) Shall be a scalar @code{INTEGER(*)}. @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: --- 6491,6499 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{ARRAY} @tab Shall be an array, of any type. ! @item @var{DIM} @tab (Optional) Shall be a scalar @code{INTEGER}. @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: *************** dimension, the lower bound is taken to b *** 6328,6333 **** --- 6512,6557 ---- + @node LEADZ + @section @code{LEADZ} --- Number of leading zero bits of an integer + @fnindex LEADZ + @cindex zero bits + + @table @asis + @item @emph{Description}: + @code{LEADZ} returns the number of leading zero bits of an integer. + + @item @emph{Standard}: + Fortran 2008 and later + + @item @emph{Class}: + Elemental function + + @item @emph{Syntax}: + @code{RESULT = LEADZ(I)} + + @item @emph{Arguments}: + @multitable @columnfractions .15 .70 + @item @var{I} @tab Shall be of type @code{INTEGER}. + @end multitable + + @item @emph{Return value}: + The type of the return value is the default @code{INTEGER}. + If all the bits of @code{I} are zero, the result value is @code{BIT_SIZE(I)}. + + @item @emph{Example}: + @smallexample + PROGRAM test_leadz + WRITE (*,*) LEADZ(1) ! prints 8 if BITSIZE(I) has the value 32 + END PROGRAM + @end smallexample + + @item @emph{See also}: + @ref{BIT_SIZE}, @ref{TRAILZ} + @end table + + + @node LEN @section @code{LEN} --- Length of a character entity @fnindex LEN *************** the length of an element of @var{STRING} *** 6341,6347 **** only the length, not the content, of @var{STRING} is needed. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Inquiry function --- 6565,6571 ---- only the length, not the content, of @var{STRING} is needed. @item @emph{Standard}: ! Fortran 77 and later, with @var{KIND} argument Fortran 2003 and later @item @emph{Class}: Inquiry function *************** Inquiry function *** 6352,6361 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{STRING} @tab Shall be a scalar or array of type ! @code{CHARACTER(*)}, with @code{INTENT(IN)} @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: --- 6576,6584 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{STRING} @tab Shall be a scalar or array of type ! @code{CHARACTER}, with @code{INTENT(IN)} @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: *************** The return value is of type @code{INTEGE *** 6378,6384 **** Returns the length of a character string, ignoring any trailing blanks. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 6601,6607 ---- Returns the length of a character string, ignoring any trailing blanks. @item @emph{Standard}: ! Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later @item @emph{Class}: Elemental function *************** Elemental function *** 6388,6398 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STRING} @tab Shall be a scalar of type @code{CHARACTER(*)}, with @code{INTENT(IN)} @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: --- 6611,6620 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STRING} @tab Shall be a scalar of type @code{CHARACTER}, with @code{INTENT(IN)} @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: *************** The return value is of type @code{INTEGE *** 6405,6463 **** - @node LGAMMA - @section @code{LGAMMA} --- Logarithm of the Gamma function - @fnindex GAMMA - @fnindex ALGAMA - @fnindex DLGAMA - @cindex Gamma function, logarithm of - - @table @asis - @item @emph{Description}: - @code{GAMMA(X)} computes the natural logrithm of the absolute value of the - Gamma (@math{\Gamma}) function. - - @item @emph{Standard}: - GNU Extension - - @item @emph{Class}: - Elemental function - - @item @emph{Syntax}: - @code{X = LGAMMA(X)} - - @item @emph{Arguments}: - @multitable @columnfractions .15 .70 - @item @var{X} @tab Shall be of type @code{REAL} and neither zero - nor a negative integer. - @end multitable - - @item @emph{Return value}: - The return value is of type @code{REAL} of the same kind as @var{X}. - - @item @emph{Example}: - @smallexample - program test_log_gamma - real :: x = 1.0 - x = lgamma(x) ! returns 0.0 - end program test_log_gamma - @end smallexample - - @item @emph{Specific names}: - @multitable @columnfractions .20 .20 .20 .25 - @item Name @tab Argument @tab Return type @tab Standard - @item @code{LGAMMA(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU Extension - @item @code{ALGAMA(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU Extension - @item @code{DLGAMA(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU Extension - @end multitable - - @item @emph{See also}: - Gamma function: @ref{GAMMA} - - @end table - - - @node LGE @section @code{LGE} --- Lexical greater than or equal @fnindex LGE --- 6627,6632 ---- *************** ASCII on some targets), whereas the form *** 6480,6486 **** ordering. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 6649,6655 ---- ordering. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** ASCII on some targets), whereas the form *** 6526,6532 **** ordering. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 6695,6701 ---- ordering. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** ASCII on some targets), whereas the form *** 6615,6621 **** ordering. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 6784,6790 ---- ordering. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** ASCII on some targets), whereas the form *** 6661,6667 **** ordering. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 6830,6836 ---- ordering. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 6707,6713 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STRING} @tab Shall be a scalar of type @code{CHARACTER(*)}, with @code{INTENT(IN)} @end multitable --- 6876,6882 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STRING} @tab Shall be a scalar of type @code{CHARACTER}, with @code{INTENT(IN)} @end multitable *************** end program test_loc *** 6777,6783 **** @code{LOG(X)} computes the logarithm of @var{X}. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 6946,6952 ---- @code{LOG(X)} computes the logarithm of @var{X}. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 6787,6799 **** @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 type @code{REAL(*)} or @code{COMPLEX(*)}. The kind type parameter is the same as @var{X}. @item @emph{Example}: @smallexample --- 6956,6970 ---- @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 type @code{REAL} or @code{COMPLEX}. The kind type parameter is the same as @var{X}. + If @var{X} is @code{COMPLEX}, the imaginary part @math{\omega} is in the range + @math{-\pi \leq \omega \leq \pi}. @item @emph{Example}: @smallexample *************** end program test_log *** 6831,6837 **** @code{LOG10(X)} computes the base 10 logarithm of @var{X}. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 7002,7008 ---- @code{LOG10(X)} computes the base 10 logarithm of @var{X}. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 6841,6851 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL(*)} or @code{COMPLEX(*)}. The kind type parameter is the same as @var{X}. @item @emph{Example}: --- 7012,7022 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL}. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL} or @code{COMPLEX}. The kind type parameter is the same as @var{X}. @item @emph{Example}: *************** end program test_log10 *** 6859,6867 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{ALOG10(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab F95 and later ! @item @code{DLOG10(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab F95 and later @end multitable @end table --- 7030,7092 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{ALOG10(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab Fortran 95 and later ! @item @code{DLOG10(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 95 and later ! @end multitable ! @end table ! ! ! ! @node LOG_GAMMA ! @section @code{LOG_GAMMA} --- Logarithm of the Gamma function ! @fnindex LOG_GAMMA ! @fnindex LGAMMA ! @fnindex ALGAMA ! @fnindex DLGAMA ! @cindex Gamma function, logarithm of ! ! @table @asis ! @item @emph{Description}: ! @code{LOG_GAMMA(X)} computes the natural logarithm of the absolute value ! of the Gamma (@math{\Gamma}) function. ! ! @item @emph{Standard}: ! Fortran 2008 and later ! ! @item @emph{Class}: ! Elemental function ! ! @item @emph{Syntax}: ! @code{X = LOG_GAMMA(X)} ! ! @item @emph{Arguments}: ! @multitable @columnfractions .15 .70 ! @item @var{X} @tab Shall be of type @code{REAL} and neither zero ! nor a negative integer. @end multitable + + @item @emph{Return value}: + The return value is of type @code{REAL} of the same kind as @var{X}. + + @item @emph{Example}: + @smallexample + program test_log_gamma + real :: x = 1.0 + x = lgamma(x) ! returns 0.0 + end program test_log_gamma + @end smallexample + + @item @emph{Specific names}: + @multitable @columnfractions .20 .20 .20 .25 + @item Name @tab Argument @tab Return type @tab Standard + @item @code{LGAMMA(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU Extension + @item @code{ALGAMA(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU Extension + @item @code{DLGAMA(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU Extension + @end multitable + + @item @emph{See also}: + Gamma function: @ref{GAMMA} + @end table *************** end program test_log10 *** 6876,6882 **** Converts one kind of @code{LOGICAL} variable to another. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 7101,7107 ---- Converts one kind of @code{LOGICAL} variable to another. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** Elemental function *** 6886,6895 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{L} @tab The type shall be @code{LOGICAL(*)}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER(*)} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: --- 7111,7119 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{L} @tab The type shall be @code{LOGICAL}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: *************** intrinsic with an optional argument of @ *** 6916,6922 **** included for backwards compatibility. @item @emph{Standard}: ! GNU extension. @item @emph{Class}: Elemental function --- 7140,7146 ---- included for backwards compatibility. @item @emph{Standard}: ! GNU extension @item @emph{Class}: Elemental function *************** Elemental function *** 6926,6933 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A} @tab Shall be of type @code{INTEGER(*)}, ! @code{REAL(*)}, or @code{COMPLEX(*)}. @end multitable @item @emph{Return value}: --- 7150,7157 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A} @tab Shall be of type @code{INTEGER}, ! @code{REAL}, or @code{COMPLEX}. @end multitable @item @emph{Return value}: *************** Elemental function *** 6966,6977 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER(*)}. ! @item @var{SHIFT} @tab The type shall be @code{INTEGER(*)}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER(*)} and of the same kind as @var{I}. @item @emph{See also}: --- 7190,7201 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER}. ! @item @var{SHIFT} @tab The type shall be @code{INTEGER}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER} and of the same kind as @var{I}. @item @emph{See also}: *************** Subroutine, function *** 7007,7016 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{FILE} @tab The type shall be @code{CHARACTER(*)}, a valid path within the file system. @item @var{BUFF} @tab The type shall be @code{INTEGER(4), DIMENSION(13)}. ! @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)}. Returns 0 ! on success and a system specific error code otherwise. @end multitable @item @emph{Example}: --- 7231,7241 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{FILE} @tab The type shall be @code{CHARACTER} of the default ! kind, a valid path within the file system. @item @var{BUFF} @tab The type shall be @code{INTEGER(4), DIMENSION(13)}. ! @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)}. ! Returns 0 on success and a system specific error code otherwise. @end multitable @item @emph{Example}: *************** Subroutine *** 7044,7061 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STIME} @tab An @code{INTEGER(*)} scalar expression ! corresponding to a system time, with ! @code{INTENT(IN)}. @item @var{TARRAY} @tab A default @code{INTEGER} array with 9 elements, ! with @code{INTENT(OUT)}. @end multitable @item @emph{Return value}: The elements of @var{TARRAY} are assigned as follows: @enumerate @item Seconds after the minute, range 0--59 or 0--61 to allow for leap ! seconds @item Minutes after the hour, range 0--59 @item Hours past midnight, range 0--23 @item Day of month, range 0--31 --- 7269,7285 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STIME} @tab An @code{INTEGER} scalar expression ! corresponding to a system time, with @code{INTENT(IN)}. @item @var{TARRAY} @tab A default @code{INTEGER} array with 9 elements, ! with @code{INTENT(OUT)}. @end multitable @item @emph{Return value}: The elements of @var{TARRAY} are assigned as follows: @enumerate @item Seconds after the minute, range 0--59 or 0--61 to allow for leap ! seconds @item Minutes after the hour, range 0--59 @item Hours past midnight, range 0--23 @item Day of month, range 0--31 *************** The elements of @var{TARRAY} are assigne *** 7064,7071 **** @item Number of days since Sunday, range 0--6 @item Days since January 1 @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}: --- 7288,7294 ---- @item Number of days since Sunday, range 0--6 @item Days since January 1 @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}: *************** Function *** 7100,7106 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{SIZE} @tab The type shall be @code{INTEGER(*)}. @end multitable @item @emph{Return value}: --- 7323,7329 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{SIZE} @tab The type shall be @code{INTEGER}. @end multitable @item @emph{Return value}: *************** C pointers (@code{sizeof(void *)}). *** 7110,7124 **** @item @emph{Example}: The following example demonstrates the use of @code{MALLOC} and ! @code{FREE} with Cray pointers. This example is intended to run on ! 32-bit systems, where the default integer kind is suitable to store ! pointers; on 64-bit systems, ptr_x would need to be declared as ! @code{integer(kind=8)}. @smallexample program test_malloc integer i - integer ptr_x real*8 x(*), z pointer(ptr_x,x) --- 7333,7344 ---- @item @emph{Example}: The following example demonstrates the use of @code{MALLOC} and ! @code{FREE} with Cray pointers. @smallexample program test_malloc + implicit none integer i real*8 x(*), z pointer(ptr_x,x) *************** end program test_malloc *** 7152,7158 **** Performs a matrix multiplication on numeric or logical arguments. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 7372,7378 ---- Performs a matrix multiplication on numeric or logical arguments. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Transformational function *** 7162,7179 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{MATRIX_A} @tab An array of @code{INTEGER(*)}, ! @code{REAL(*)}, @code{COMPLEX(*)}, or ! @code{LOGICAL(*)} type, with a rank of ! one or two. ! @item @var{MATRIX_B} @tab An array of @code{INTEGER(*)}, ! @code{REAL(*)}, or @code{COMPLEX(*)} type if ! @var{MATRIX_A} is of a numeric type; ! otherwise, an array of @code{LOGICAL(*)} ! type. The rank shall be one or two, and the ! first (or only) dimension of @var{MATRIX_B} ! shall be equal to the last (or only) ! dimension of @var{MATRIX_A}. @end multitable @item @emph{Return value}: --- 7382,7395 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{MATRIX_A} @tab An array of @code{INTEGER}, ! @code{REAL}, @code{COMPLEX}, or @code{LOGICAL} type, with a rank of ! one or two. ! @item @var{MATRIX_B} @tab An array of @code{INTEGER}, ! @code{REAL}, or @code{COMPLEX} type if @var{MATRIX_A} is of a numeric ! type; otherwise, an array of @code{LOGICAL} type. The rank shall be one ! or two, and the first (or only) dimension of @var{MATRIX_B} shall be ! equal to the last (or only) dimension of @var{MATRIX_A}. @end multitable @item @emph{Return value}: *************** for the @code{*} or @code{.AND.} operato *** 7201,7207 **** Returns the argument with the largest (most positive) value. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 7417,7423 ---- Returns the argument with the largest (most positive) value. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 7211,7222 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A1} @tab The type shall be @code{INTEGER(*)} or ! @code{REAL(*)}. @item @var{A2}, @var{A3}, ... @tab An expression of the same type and kind ! as @var{A1}. (As a GNU extension, ! arguments of different kinds are ! permitted.) @end multitable @item @emph{Return value}: --- 7427,7437 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A1} @tab The type shall be @code{INTEGER} or ! @code{REAL}. @item @var{A2}, @var{A3}, ... @tab An expression of the same type and kind ! as @var{A1}. (As a GNU extension, arguments of different kinds are ! permitted.) @end multitable @item @emph{Return value}: *************** and has the same type and kind as the fi *** 7226,7236 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{MAX0(I)} @tab @code{INTEGER(4) I} @tab @code{INTEGER(4)} @tab F77 and later ! @item @code{AMAX0(I)} @tab @code{INTEGER(4) I} @tab @code{REAL(MAX(X))} @tab F77 and later ! @item @code{MAX1(X)} @tab @code{REAL(*) X} @tab @code{INT(MAX(X))} @tab F77 and later ! @item @code{AMAX1(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab F77 and later ! @item @code{DMAX1(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab F77 and later @end multitable @item @emph{See also}: --- 7441,7451 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{MAX0(I)} @tab @code{INTEGER(4) I} @tab @code{INTEGER(4)} @tab Fortran 77 and later ! @item @code{AMAX0(I)} @tab @code{INTEGER(4) I} @tab @code{REAL(MAX(X))} @tab Fortran 77 and later ! @item @code{MAX1(X)} @tab @code{REAL X} @tab @code{INT(MAX(X))} @tab Fortran 77 and later ! @item @code{AMAX1(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab Fortran 77 and later ! @item @code{DMAX1(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @end multitable @item @emph{See also}: *************** and has the same type and kind as the fi *** 7251,7257 **** type of @code{X}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function --- 7466,7472 ---- type of @code{X}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Inquiry function *************** and all of the elements of @var{MASK} al *** 7302,7308 **** result value for that row is zero. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 7517,7523 ---- result value for that row is zero. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Transformational function *** 7315,7328 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{ARRAY} @tab Shall be an array of type @code{INTEGER(*)}, ! @code{REAL(*)}, or @code{CHARACTER(*)}. @item @var{DIM} @tab (Optional) Shall be a scalar of type ! @code{INTEGER(*)}, with a value between one ! and the rank of @var{ARRAY}, inclusive. It ! may not be an optional dummy argument. ! @item @var{MASK} @tab Shall be an array of type @code{LOGICAL(*)}, ! and conformable with @var{ARRAY}. @end multitable @item @emph{Return value}: --- 7530,7542 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{ARRAY} @tab Shall be an array of type @code{INTEGER}, ! @code{REAL}, or @code{CHARACTER}. @item @var{DIM} @tab (Optional) Shall be a scalar of type ! @code{INTEGER}, with a value between one and the rank of @var{ARRAY}, ! inclusive. It may not be an optional dummy argument. ! @item @var{MASK} @tab Shall be an array of type @code{LOGICAL}, ! and conformable with @var{ARRAY}. @end multitable @item @emph{Return value}: *************** the @var{DIM} argument is supplied, dete *** 7354,7365 **** each row of the array in the @var{DIM} direction. If @var{MASK} is present, only the elements for which @var{MASK} is @code{.TRUE.} are considered. If the array has zero size, or all of the elements of ! @var{MASK} are @code{.FALSE.}, then the result is the most negative ! number of the type and kind of @var{ARRAY} if @var{ARRAY} is numeric, or ! a string of nulls if @var{ARRAY} is of character type. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 7568,7579 ---- each row of the array in the @var{DIM} direction. If @var{MASK} is present, only the elements for which @var{MASK} is @code{.TRUE.} are considered. If the array has zero size, or all of the elements of ! @var{MASK} are @code{.FALSE.}, then the result is @code{-HUGE(ARRAY)} ! if @var{ARRAY} is numeric, or a string of nulls if @var{ARRAY} is of character ! type. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Transformational function *** 7372,7385 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{ARRAY} @tab Shall be an array of type @code{INTEGER(*)}, ! @code{REAL(*)}, or @code{CHARACTER(*)}. @item @var{DIM} @tab (Optional) Shall be a scalar of type ! @code{INTEGER(*)}, with a value between one ! and the rank of @var{ARRAY}, inclusive. It ! may not be an optional dummy argument. ! @item @var{MASK} @tab Shall be an array of type @code{LOGICAL(*)}, ! and conformable with @var{ARRAY}. @end multitable @item @emph{Return value}: --- 7586,7598 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{ARRAY} @tab Shall be an array of type @code{INTEGER}, ! @code{REAL}, or @code{CHARACTER}. @item @var{DIM} @tab (Optional) Shall be a scalar of type ! @code{INTEGER}, with a value between one and the rank of @var{ARRAY}, ! inclusive. It may not be an optional dummy argument. ! @item @var{MASK} @tab Shall be an array of type @code{LOGICAL}, ! and conformable with @var{ARRAY}. @end multitable @item @emph{Return value}: *************** is equal to @var{TSOURCE} if @var{MASK} *** 7486,7492 **** @var{FSOURCE} if it is @code{.FALSE.}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 7699,7705 ---- @var{FSOURCE} if it is @code{.FALSE.}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** Elemental function *** 7498,7505 **** @multitable @columnfractions .15 .70 @item @var{TSOURCE} @tab May be of any type. @item @var{FSOURCE} @tab Shall be of the same type and type parameters ! as @var{TSOURCE}. ! @item @var{MASK} @tab Shall be of type @code{LOGICAL(*)}. @end multitable @item @emph{Return value}: --- 7711,7718 ---- @multitable @columnfractions .15 .70 @item @var{TSOURCE} @tab May be of any type. @item @var{FSOURCE} @tab Shall be of the same type and type parameters ! as @var{TSOURCE}. ! @item @var{MASK} @tab Shall be of type @code{LOGICAL}. @end multitable @item @emph{Return value}: *************** The result is of the same type and type *** 7524,7530 **** Returns the argument with the smallest (most negative) value. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 7737,7743 ---- Returns the argument with the smallest (most negative) value. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 7534,7545 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A1} @tab The type shall be @code{INTEGER(*)} or ! @code{REAL(*)}. @item @var{A2}, @var{A3}, ... @tab An expression of the same type and kind ! as @var{A1}. (As a GNU extension, ! arguments of different kinds are ! permitted.) @end multitable @item @emph{Return value}: --- 7747,7757 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{A1} @tab The type shall be @code{INTEGER} or ! @code{REAL}. @item @var{A2}, @var{A3}, ... @tab An expression of the same type and kind ! as @var{A1}. (As a GNU extension, arguments of different kinds are ! permitted.) @end multitable @item @emph{Return value}: *************** and has the same type and kind as the fi *** 7549,7559 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{MIN0(I)} @tab @code{INTEGER(4) I} @tab @code{INTEGER(4)} @tab F77 and later ! @item @code{AMIN0(I)} @tab @code{INTEGER(4) I} @tab @code{REAL(MIN(X))} @tab F77 and later ! @item @code{MIN1(X)} @tab @code{REAL(*) X} @tab @code{INT(MIN(X))} @tab F77 and later ! @item @code{AMIN1(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab F77 and later ! @item @code{DMIN1(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab F77 and later @end multitable @item @emph{See also}: --- 7761,7771 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{MIN0(I)} @tab @code{INTEGER(4) I} @tab @code{INTEGER(4)} @tab Fortran 77 and later ! @item @code{AMIN0(I)} @tab @code{INTEGER(4) I} @tab @code{REAL(MIN(X))} @tab Fortran 77 and later ! @item @code{MIN1(X)} @tab @code{REAL X} @tab @code{INT(MIN(X))} @tab Fortran 77 and later ! @item @code{AMIN1(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab Fortran 77 and later ! @item @code{DMIN1(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @end multitable @item @emph{See also}: *************** and has the same type and kind as the fi *** 7573,7579 **** type of @code{X}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function --- 7785,7791 ---- type of @code{X}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Inquiry function *************** and all of the elements of @var{MASK} al *** 7616,7622 **** result value for that row is zero. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 7828,7834 ---- result value for that row is zero. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Transformational function *** 7629,7642 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{ARRAY} @tab Shall be an array of type @code{INTEGER(*)}, ! @code{REAL(*)}, or @code{CHARACTER(*)}. @item @var{DIM} @tab (Optional) Shall be a scalar of type ! @code{INTEGER(*)}, with a value between one ! and the rank of @var{ARRAY}, inclusive. It ! may not be an optional dummy argument. ! @item @var{MASK} @tab Shall be an array of type @code{LOGICAL(*)}, ! and conformable with @var{ARRAY}. @end multitable @item @emph{Return value}: --- 7841,7853 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{ARRAY} @tab Shall be an array of type @code{INTEGER}, ! @code{REAL}, or @code{CHARACTER}. @item @var{DIM} @tab (Optional) Shall be a scalar of type ! @code{INTEGER}, with a value between one and the rank of @var{ARRAY}, ! inclusive. It may not be an optional dummy argument. ! @item @var{MASK} @tab Shall be an array of type @code{LOGICAL}, ! and conformable with @var{ARRAY}. @end multitable @item @emph{Return value}: *************** considered. If the array has zero size, *** 7673,7679 **** @var{ARRAY} is of character type. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 7884,7890 ---- @var{ARRAY} is of character type. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Transformational function *** 7686,7699 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{ARRAY} @tab Shall be an array of type @code{INTEGER(*)}, ! @code{REAL(*)}, or @code{CHARACTER(*)}. @item @var{DIM} @tab (Optional) Shall be a scalar of type ! @code{INTEGER(*)}, with a value between one ! and the rank of @var{ARRAY}, inclusive. It ! may not be an optional dummy argument. ! @item @var{MASK} @tab Shall be an array of type @code{LOGICAL(*)}, ! and conformable with @var{ARRAY}. @end multitable @item @emph{Return value}: --- 7897,7909 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{ARRAY} @tab Shall be an array of type @code{INTEGER}, ! @code{REAL}, or @code{CHARACTER}. @item @var{DIM} @tab (Optional) Shall be a scalar of type ! @code{INTEGER}, with a value between one and the rank of @var{ARRAY}, ! inclusive. It may not be an optional dummy argument. ! @item @var{MASK} @tab Shall be an array of type @code{LOGICAL}, ! and conformable with @var{ARRAY}. @end multitable @item @emph{Return value}: *************** cases, the result is of the same type an *** 7720,7730 **** @table @asis @item @emph{Description}: ! @code{MOD(A,P)} computes the remainder of the division of A by P. It is calculated as @code{A - (INT(A/P) * P)}. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 7930,7940 ---- @table @asis @item @emph{Description}: ! @code{MOD(A,P)} computes the remainder of the division of A by P@. It is calculated as @code{A - (INT(A/P) * P)}. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** end program test_mod *** 7766,7773 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Arguments @tab Return type @tab Standard ! @item @code{AMOD(A,P)} @tab @code{REAL(4)} @tab @code{REAL(4)} @tab F95 and later ! @item @code{DMOD(A,P)} @tab @code{REAL(8)} @tab @code{REAL(8)} @tab F95 and later @end multitable @end table --- 7976,7983 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Arguments @tab Return type @tab Standard ! @item @code{AMOD(A,P)} @tab @code{REAL(4)} @tab @code{REAL(4)} @tab Fortran 95 and later ! @item @code{DMOD(A,P)} @tab @code{REAL(8)} @tab @code{REAL(8)} @tab Fortran 95 and later @end multitable @end table *************** end program test_mod *** 7784,7790 **** @code{MODULO(A,P)} computes the @var{A} modulo @var{P}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 7994,8000 ---- @code{MODULO(A,P)} computes the @var{A} modulo @var{P}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** end program *** 7840,7846 **** @var{DEST}. @var{SRC} will become deallocated in the process. @item @emph{Standard}: ! F2003 and later @item @emph{Class}: Subroutine --- 8050,8056 ---- @var{DEST}. @var{SRC} will become deallocated in the process. @item @emph{Standard}: ! Fortran 2003 and later @item @emph{Class}: Subroutine *************** Subroutine *** 7851,7859 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{SRC} @tab @code{ALLOCATABLE}, @code{INTENT(INOUT)}, may be ! of any type and kind. @item @var{DEST} @tab @code{ALLOCATABLE}, @code{INTENT(OUT)}, shall be ! of the same type, kind and rank as @var{SRC} @end multitable @item @emph{Return value}: --- 8061,8069 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{SRC} @tab @code{ALLOCATABLE}, @code{INTENT(INOUT)}, may be ! of any type and kind. @item @var{DEST} @tab @code{ALLOCATABLE}, @code{INTENT(OUT)}, shall be ! of the same type, kind and rank as @var{SRC}. @end multitable @item @emph{Return value}: *************** affected by the movement of bits is unch *** 7890,7896 **** @code{BIT_SIZE(FROM)}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental subroutine --- 8100,8106 ---- @code{BIT_SIZE(FROM)}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental subroutine *************** Elemental subroutine *** 7900,7911 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{FROM} @tab The type shall be @code{INTEGER(*)}. ! @item @var{FROMPOS} @tab The type shall be @code{INTEGER(*)}. ! @item @var{LEN} @tab The type shall be @code{INTEGER(*)}. ! @item @var{TO} @tab The type shall be @code{INTEGER(*)}, of the ! same kind as @var{FROM}. ! @item @var{TOPOS} @tab The type shall be @code{INTEGER(*)}. @end multitable @item @emph{See also}: --- 8110,8121 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{FROM} @tab The type shall be @code{INTEGER}. ! @item @var{FROMPOS} @tab The type shall be @code{INTEGER}. ! @item @var{LEN} @tab The type shall be @code{INTEGER}. ! @item @var{TO} @tab The type shall be @code{INTEGER}, of the ! same kind as @var{FROM}. ! @item @var{TOPOS} @tab The type shall be @code{INTEGER}. @end multitable @item @emph{See also}: *************** Elemental subroutine *** 7926,7932 **** to @code{X} in the direction indicated by the sign of @code{S}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 8136,8142 ---- to @code{X} in the direction indicated by the sign of @code{S}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** end program test_nearest *** 7972,7978 **** @code{NEW_LINE(C)} returns the new-line character. @item @emph{Standard}: ! F2003 and later @item @emph{Class}: Inquiry function --- 8182,8188 ---- @code{NEW_LINE(C)} returns the new-line character. @item @emph{Standard}: ! Fortran 2003 and later @item @emph{Class}: Inquiry function *************** Inquiry function *** 7983,7989 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{C} @tab The argument shall be a scalar or array of the ! type @code{CHARACTER}. @end multitable @item @emph{Return value}: --- 8193,8199 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{C} @tab The argument shall be a scalar or array of the ! type @code{CHARACTER}. @end multitable @item @emph{Return value}: *************** end program newline *** 8012,8028 **** @code{NINT(X)} rounds its argument to the nearest whole number. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = NINT(X)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{X} @tab The type of the argument shall be @code{REAL}. @end multitable @item @emph{Return value}: --- 8222,8240 ---- @code{NINT(X)} rounds its argument to the nearest whole number. @item @emph{Standard}: ! Fortran 77 and later, with @var{KIND} argument Fortran 90 and later @item @emph{Class}: Elemental function @item @emph{Syntax}: ! @code{RESULT = NINT(X [, KIND])} @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{X} @tab The type of the argument shall be @code{REAL}. + @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization + expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: *************** end program test_nint *** 8044,8050 **** @item @emph{Specific names}: @multitable @columnfractions .25 .25 .25 @item Name @tab Argument @tab Standard ! @item @code{IDNINT(X)} @tab @code{REAL(8)} @tab F95 and later @end multitable @item @emph{See also}: --- 8256,8262 ---- @item @emph{Specific names}: @multitable @columnfractions .25 .25 .25 @item Name @tab Argument @tab Standard ! @item @code{IDNINT(X)} @tab @code{REAL(8)} @tab Fortran 95 and later @end multitable @item @emph{See also}: *************** end program test_nint *** 8066,8072 **** @code{NOT} returns the bitwise boolean inverse of @var{I}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 8278,8284 ---- @code{NOT} returns the bitwise boolean inverse of @var{I}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** Elemental function *** 8076,8086 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER(*)}. @end multitable @item @emph{Return value}: ! The return type is @code{INTEGER(*)}, of the same kind as the argument. @item @emph{See also}: --- 8288,8298 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER}. @end multitable @item @emph{Return value}: ! The return type is @code{INTEGER}, of the same kind as the argument. @item @emph{See also}: *************** Returns a disassociated pointer. *** 8103,8113 **** If @var{MOLD} is present, a dissassociated pointer of the same type is returned, otherwise the type is determined by context. ! In Fortran 95, @var{MOLD} is optional. Please note that F2003 includes ! cases where it is required. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 8315,8325 ---- If @var{MOLD} is present, a dissassociated pointer of the same type is returned, otherwise the type is determined by context. ! In Fortran 95, @var{MOLD} is optional. Please note that Fortran 2003 ! includes cases where it is required. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Function *** 8160,8172 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be either @code{INTEGER(*)} or @code{LOGICAL}. ! @item @var{Y} @tab The type shall be either @code{INTEGER(*)} or @code{LOGICAL}. @end multitable @item @emph{Return value}: ! The return type is either @code{INTEGER(*)} or @code{LOGICAL} ! after cross-promotion of the arguments. @item @emph{Example}: @smallexample --- 8372,8387 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be either a scalar @code{INTEGER} ! type or a scalar @code{LOGICAL} type. ! @item @var{Y} @tab The type shall be the same as the type of @var{X}. @end multitable @item @emph{Return value}: ! The return type is either a scalar @code{INTEGER} or a scalar ! @code{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. @item @emph{Example}: @smallexample *************** END PROGRAM *** 8181,8187 **** @end smallexample @item @emph{See also}: ! F95 elemental function: @ref{IOR} @end table --- 8396,8402 ---- @end smallexample @item @emph{See also}: ! Fortran 95 elemental function: @ref{IOR} @end table *************** equals @code{TRUE}. Afterwards, position *** 8202,8208 **** @var{VECTOR}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 8417,8423 ---- @var{VECTOR}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Subroutine *** 8276,8282 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STRING} @tab A scalar of default @code{CHARACTER} type. @end multitable @item @emph{See also}: --- 8491,8498 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STRING} @tab A scalar of type @code{CHARACTER} and of the ! default kind. @end multitable @item @emph{See also}: *************** Subroutine *** 8296,8302 **** type of @code{X}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function --- 8512,8518 ---- type of @code{X}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Inquiry function *************** end program prec_and_range *** 8336,8342 **** Determines whether an optional dummy argument is present. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function --- 8552,8558 ---- Determines whether an optional dummy argument is present. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Inquiry function *************** Multiplies the elements of @var{ARRAY} a *** 8384,8390 **** the corresponding element in @var{MASK} is @code{TRUE}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 8600,8606 ---- the corresponding element in @var{MASK} is @code{TRUE}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Transformational function *** 8395,8402 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{ARRAY} @tab Shall be an array of type @code{INTEGER(*)}, ! @code{REAL(*)} or @code{COMPLEX(*)}. @item @var{DIM} @tab (Optional) shall be a scalar of type @code{INTEGER} with a value in the range from 1 to n, where n equals the rank of @var{ARRAY}. --- 8611,8618 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{ARRAY} @tab Shall be an array of type @code{INTEGER}, ! @code{REAL} or @code{COMPLEX}. @item @var{DIM} @tab (Optional) shall be a scalar of type @code{INTEGER} with a value in the range from 1 to n, where n equals the rank of @var{ARRAY}. *************** END PROGRAM *** 8439,8445 **** @code{RADIX(X)} returns the base of the model representing the entity @var{X}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function --- 8655,8661 ---- @code{RADIX(X)} returns the base of the model representing the entity @var{X}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Inquiry function *************** with a period of @math{2^{32}}, *** 8566,8579 **** The overall period exceeds @math{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. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Subroutine --- 8782,8795 ---- The overall period exceeds @math{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. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Subroutine *************** Subroutine *** 8583,8589 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{HARVEST} @tab Shall be a scalar or an array of type @code{REAL(*)}. @end multitable @item @emph{Example}: --- 8799,8805 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{HARVEST} @tab Shall be a scalar or an array of type @code{REAL}. @end multitable @item @emph{Example}: *************** a default state. The example below shows *** 8617,8623 **** seed based on the system's time. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Subroutine --- 8833,8839 ---- seed based on the system's time. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Subroutine *************** END SUBROUTINE *** 8665,8671 **** @node RANGE ! @section @code{RANGE} --- Decimal exponent range of a real kind @fnindex RANGE @cindex model representation, range --- 8881,8887 ---- @node RANGE ! @section @code{RANGE} --- Decimal exponent range @fnindex RANGE @cindex model representation, range *************** END SUBROUTINE *** 8675,8681 **** type of @code{X}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function --- 8891,8897 ---- type of @code{X}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Inquiry function *************** Inquiry function *** 8685,8691 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab Shall be of type @code{REAL} or @code{COMPLEX}. @end multitable @item @emph{Return value}: --- 8901,8908 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab Shall be of type @code{INTEGER}, @code{REAL} ! or @code{COMPLEX}. @end multitable @item @emph{Return value}: *************** See @code{PRECISION} for an example. *** 8712,8718 **** and its use is strongly discouraged. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 8929,8935 ---- and its use is strongly discouraged. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 8725,8739 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab Shall be @code{INTEGER(*)}, @code{REAL(*)}, or ! @code{COMPLEX(*)}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER(*)} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: ! These functions return a @code{REAL(*)} variable or array under the following rules: @table @asis --- 8942,8955 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab Shall be @code{INTEGER}, @code{REAL}, or ! @code{COMPLEX}. ! @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: ! These functions return a @code{REAL} variable or array under the following rules: @table @asis *************** Subroutine, function *** 8818,8824 **** Concatenates @var{NCOPIES} copies of a string. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 9034,9040 ---- Concatenates @var{NCOPIES} copies of a string. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Transformational function *** 8828,8835 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STRING} @tab Shall be scalar and of type @code{CHARACTER(*)}. ! @item @var{NCOPIES} @tab Shall be scalar and of type @code{INTEGER(*)}. @end multitable @item @emph{Return value}: --- 9044,9051 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STRING} @tab Shall be scalar and of type @code{CHARACTER}. ! @item @var{NCOPIES} @tab Shall be scalar and of type @code{INTEGER}. @end multitable @item @emph{Return value}: *************** the new array may be padded with element *** 8859,8865 **** as defined by @var{ORDER}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 9075,9081 ---- as defined by @var{ORDER}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** END PROGRAM *** 8913,8919 **** model numbers near @var{X}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 9129,9135 ---- model numbers near @var{X}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** Elemental function *** 8964,8975 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER(*)}. ! @item @var{SHIFT} @tab The type shall be @code{INTEGER(*)}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER(*)} and of the same kind as @var{I}. @item @emph{See also}: --- 9180,9191 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{I} @tab The type shall be @code{INTEGER}. ! @item @var{SHIFT} @tab The type shall be @code{INTEGER}. @end multitable @item @emph{Return value}: ! The return value is of type @code{INTEGER} and of the same kind as @var{I}. @item @emph{See also}: *************** The return value is of type @code{INTEGE *** 8990,8996 **** @code{SCALE(X,I)} returns @code{X * RADIX(X)**I}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 9206,9212 ---- @code{SCALE(X,I)} returns @code{X * RADIX(X)**I}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** is returned. If no character of @var{SET *** 9038,9044 **** result is zero. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 9254,9260 ---- result is zero. @item @emph{Standard}: ! Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later @item @emph{Class}: Elemental function *************** Elemental function *** 9048,9059 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STRING} @tab Shall be of type @code{CHARACTER(*)}. ! @item @var{SET} @tab Shall be of type @code{CHARACTER(*)}. @item @var{BACK} @tab (Optional) shall be of type @code{LOGICAL}. @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: --- 9264,9274 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STRING} @tab Shall be of type @code{CHARACTER}. ! @item @var{SET} @tab Shall be of type @code{CHARACTER}. @item @var{BACK} @tab (Optional) shall be of type @code{LOGICAL}. @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: *************** seconds. *** 9167,9172 **** --- 9382,9429 ---- + @node SELECTED_CHAR_KIND + @section @code{SELECTED_CHAR_KIND} --- Choose character kind + @fnindex SELECTED_CHAR_KIND + @cindex character kind + @cindex kind, character + + @table @asis + @item @emph{Description}: + + @code{SELECTED_CHAR_KIND(NAME)} returns the kind value for the character + set named @var{NAME}, if a character set with such a name is supported, + or @math{-1} otherwise. Currently, supported character sets include + ``ASCII'' and ``DEFAULT'', which are equivalent. + + @item @emph{Standard}: + Fortran 2003 and later + + @item @emph{Class}: + Transformational function + + @item @emph{Syntax}: + @code{RESULT = SELECTED_CHAR_KIND(NAME)} + + @item @emph{Arguments}: + @multitable @columnfractions .15 .70 + @item @var{NAME} @tab Shall be a scalar and of the default character type. + @end multitable + + @item @emph{Example}: + @smallexample + program ascii_kind + integer,parameter :: ascii = selected_char_kind("ascii") + character(kind=ascii, len=26) :: s + + s = ascii_"abcdefghijklmnopqrstuvwxyz" + print *, s + end program ascii_kind + @end smallexample + @end table + + + @node SELECTED_INT_KIND @section @code{SELECTED_INT_KIND} --- Choose integer kind @fnindex SELECTED_INT_KIND *************** to @math{10^I} (exclusive). If there is *** 9181,9187 **** this range, @code{SELECTED_INT_KIND} returns @math{-1}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 9438,9444 ---- this range, @code{SELECTED_INT_KIND} returns @math{-1}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** end program large_integers *** 9221,9232 **** @table @asis @item @emph{Description}: ! @code{SELECTED_REAL_KIND(P,R)} return the kind value of a real data type ! with decimal precision greater of at least @code{P} digits and exponent range greater at least @code{R}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 9478,9489 ---- @table @asis @item @emph{Description}: ! @code{SELECTED_REAL_KIND(P,R)} returns the kind value of a real data type ! with decimal precision of at least @code{P} digits and exponent range greater at least @code{R}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** end program real_kinds *** 9288,9294 **** is that that of @var{X} and whose exponent part is @var{I}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 9545,9551 ---- is that that of @var{X} and whose exponent part is @var{I}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** END PROGRAM *** 9331,9337 **** Determines the shape of an array. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function --- 9588,9594 ---- Determines the shape of an array. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Inquiry function *************** END PROGRAM *** 9379,9385 **** @code{SIGN(A,B)} returns the value of @var{A} with the sign of @var{B}. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 9636,9642 ---- @code{SIGN(A,B)} returns the value of @var{A} with the sign of @var{B}. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Subroutine, function *** 9458,9463 **** --- 9715,9721 ---- @item @var{STATUS} @tab (Optional) @var{STATUS} shall be a scalar integer. It has @code{INTENT(OUT)}. @end multitable + @c TODO: What should the interface of the handler be? Does it take arguments? @item @emph{Return value}: The @code{SIGNAL} function returns the value returned by @code{signal(2)}. *************** end program test_signal *** 9493,9499 **** @code{SIN(X)} computes the sine of @var{X}. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 9751,9757 ---- @code{SIN(X)} computes the sine of @var{X}. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 9503,9510 **** @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}: --- 9761,9768 ---- @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}: *************** end program test_sin *** 9546,9552 **** @code{SINH(X)} computes the hyperbolic sine of @var{X}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 9804,9810 ---- @code{SINH(X)} computes the hyperbolic sine of @var{X}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** Elemental function *** 9556,9566 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL(*)}. @item @emph{Example}: @smallexample --- 9814,9824 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL}. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL}. @item @emph{Example}: @smallexample *************** end program test_sinh *** 9573,9579 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DSINH(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab F95 and later @end multitable @item @emph{See also}: --- 9831,9837 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DSINH(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 95 and later @end multitable @item @emph{See also}: *************** Determine the extent of @var{ARRAY} alon *** 9595,9601 **** or the total number of elements in @var{ARRAY} if @var{DIM} is absent. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function --- 9853,9859 ---- or the total number of elements in @var{ARRAY} if @var{DIM} is absent. @item @emph{Standard}: ! Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later @item @emph{Class}: Inquiry function *************** a pointer it must be associated and allo *** 9611,9618 **** and its value shall be in the range from 1 to n, where n equals the rank of @var{ARRAY}. @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: --- 9869,9875 ---- and its value shall be in the range from 1 to n, where n equals the rank of @var{ARRAY}. @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: *************** the sizes of the data pointed to by thes *** 9674,9681 **** --- 9931,9942 ---- @end smallexample The example will print @code{.TRUE.} unless you are using a platform where default @code{REAL} variables are unusually padded. + + @item @emph{See also}: + @ref{C_SIZEOF} @end table + @node SLEEP @section @code{SLEEP} --- Sleep for the specified number of seconds @fnindex SLEEP *************** to a default real value. This is an arch *** 9721,9727 **** that is specific to one type for @var{A}. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 9982,9988 ---- that is specific to one type for @var{A}. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Determines the distance between the argu *** 9755,9761 **** adjacent number of the same type. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 10016,10022 ---- adjacent number of the same type. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Elemental function *************** Elemental function *** 9765,9771 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab Shall be of type @code{REAL(*)}. @end multitable @item @emph{Return value}: --- 10026,10032 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab Shall be of type @code{REAL}. @end multitable @item @emph{Return value}: *************** Replicates a @var{SOURCE} array @var{NCO *** 9801,9807 **** dimension @var{DIM}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 10062,10068 ---- dimension @var{DIM}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** END PROGRAM *** 9852,9858 **** @code{SQRT(X)} computes the square root of @var{X}. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 10113,10119 ---- @code{SQRT(X)} computes the square root of @var{X}. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 9862,9873 **** @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 type @code{REAL(*)} or @code{COMPLEX(*)}. The kind type parameter is the same as @var{X}. @item @emph{Example}: --- 10123,10134 ---- @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 type @code{REAL} or @code{COMPLEX}. The kind type parameter is the same as @var{X}. @item @emph{Example}: *************** end program test_sqrt *** 9883,9890 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DSQRT(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab F95 and later ! @item @code{CSQRT(X)} @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab F95 and later @item @code{ZSQRT(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension @item @code{CDSQRT(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension @end multitable --- 10144,10151 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DSQRT(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 95 and later ! @item @code{CSQRT(X)} @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab Fortran 95 and later @item @code{ZSQRT(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension @item @code{CDSQRT(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension @end multitable *************** Subroutine *** 9919,9925 **** @end multitable @item @emph{Return value}: ! Does not return. @item @emph{Example}: See @code{RAND} and @code{IRAND} for examples. --- 10180,10186 ---- @end multitable @item @emph{Return value}: ! Does not return anything. @item @emph{Example}: See @code{RAND} and @code{IRAND} for examples. *************** Subroutine, function *** 9985,9994 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{FILE} @tab The type shall be @code{CHARACTER(*)}, a valid path within the file system. @item @var{BUFF} @tab The type shall be @code{INTEGER(4), DIMENSION(13)}. @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)}. Returns 0 ! on success and a system specific error code otherwise. @end multitable @item @emph{Example}: --- 10246,10256 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{FILE} @tab The type shall be @code{CHARACTER}, of the ! default kind and a valid path within the file system. @item @var{BUFF} @tab The type shall be @code{INTEGER(4), DIMENSION(13)}. @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)}. Returns 0 ! on success and a system specific error code otherwise. @end multitable @item @emph{Example}: *************** Adds the elements of @var{ARRAY} along d *** 10037,10043 **** the corresponding element in @var{MASK} is @code{TRUE}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 10299,10305 ---- the corresponding element in @var{MASK} is @code{TRUE}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Transformational function *** 10048,10055 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{ARRAY} @tab Shall be an array of type @code{INTEGER(*)}, ! @code{REAL(*)} or @code{COMPLEX(*)}. @item @var{DIM} @tab (Optional) shall be a scalar of type @code{INTEGER} with a value in the range from 1 to n, where n equals the rank of @var{ARRAY}. --- 10310,10317 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{ARRAY} @tab Shall be an array of type @code{INTEGER}, ! @code{REAL} or @code{COMPLEX}. @item @var{DIM} @tab (Optional) shall be a scalar of type @code{INTEGER} with a value in the range from 1 to n, where n equals the rank of @var{ARRAY}. *************** If there is no clock, @var{COUNT} is set *** 10182,10188 **** @var{COUNT_RATE} and @var{COUNT_MAX} are set to zero @item @emph{Standard}: ! F95 and later @item @emph{Class}: Subroutine --- 10444,10450 ---- @var{COUNT_RATE} and @var{COUNT_MAX} are set to zero @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Subroutine *************** END PROGRAM *** 10228,10234 **** @code{TAN(X)} computes the tangent of @var{X}. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 10490,10496 ---- @code{TAN(X)} computes the tangent of @var{X}. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 10238,10248 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL(*)}. The kind type parameter is the same as @var{X}. @item @emph{Example}: --- 10500,10510 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL}. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL}. The kind type parameter is the same as @var{X}. @item @emph{Example}: *************** end program test_tan *** 10256,10262 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DTAN(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab F95 and later @end multitable @item @emph{See also}: --- 10518,10524 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DTAN(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 95 and later @end multitable @item @emph{See also}: *************** end program test_tan *** 10278,10284 **** @code{TANH(X)} computes the hyperbolic tangent of @var{X}. @item @emph{Standard}: ! F77 and later @item @emph{Class}: Elemental function --- 10540,10546 ---- @code{TANH(X)} computes the hyperbolic tangent of @var{X}. @item @emph{Standard}: ! Fortran 77 and later @item @emph{Class}: Elemental function *************** Elemental function *** 10288,10298 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL(*)}. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL(*)} and lies in the range @math{ - 1 \leq tanh(x) \leq 1 }. @item @emph{Example}: --- 10550,10560 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be @code{REAL}. @end multitable @item @emph{Return value}: ! The return value is of type @code{REAL} and lies in the range @math{ - 1 \leq tanh(x) \leq 1 }. @item @emph{Example}: *************** end program test_tanh *** 10306,10312 **** @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DTANH(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab F95 and later @end multitable @item @emph{See also}: --- 10568,10574 ---- @item @emph{Specific names}: @multitable @columnfractions .20 .20 .20 .25 @item Name @tab Argument @tab Return type @tab Standard ! @item @code{DTANH(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 95 and later @end multitable @item @emph{See also}: *************** The return value is a scalar of type @co *** 10407,10413 **** in the model of the type of @code{X}. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function --- 10669,10675 ---- in the model of the type of @code{X}. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Inquiry function *************** See @code{HUGE} for an example. *** 10429,10434 **** --- 10691,10736 ---- + @node TRAILZ + @section @code{TRAILZ} --- Number of trailing zero bits of an integer + @fnindex TRAILZ + @cindex zero bits + + @table @asis + @item @emph{Description}: + @code{TRAILZ} returns the number of trailing zero bits of an integer. + + @item @emph{Standard}: + Fortran 2008 and later + + @item @emph{Class}: + Elemental function + + @item @emph{Syntax}: + @code{RESULT = TRAILZ(I)} + + @item @emph{Arguments}: + @multitable @columnfractions .15 .70 + @item @var{I} @tab Shall be of type @code{INTEGER}. + @end multitable + + @item @emph{Return value}: + The type of the return value is the default @code{INTEGER}. + If all the bits of @code{I} are zero, the result value is @code{BIT_SIZE(I)}. + + @item @emph{Example}: + @smallexample + PROGRAM test_trailz + WRITE (*,*) TRAILZ(8) ! prints 3 + END PROGRAM + @end smallexample + + @item @emph{See also}: + @ref{BIT_SIZE}, @ref{LEADZ} + @end table + + + @node TRANSFER @section @code{TRANSFER} --- Transfer bit patterns @fnindex TRANSFER *************** This is approximately equivalent to the *** 10445,10451 **** type to another. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 10747,10753 ---- type to another. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Transpose an array of rank two. Element *** 10505,10511 **** @code{MATRIX(j, i)}, for all i, j. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 10807,10813 ---- @code{MATRIX(j, i)}, for all i, j. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Transformational function *** 10519,10525 **** @end multitable @item @emph{Return value}: ! The result has the the same type as @var{MATRIX}, and has shape @code{(/ m, n /)} if @var{MATRIX} has shape @code{(/ n, m /)}. @end table --- 10821,10827 ---- @end multitable @item @emph{Return value}: ! The result has the same type as @var{MATRIX}, and has shape @code{(/ m, n /)} if @var{MATRIX} has shape @code{(/ n, m /)}. @end table *************** The result has the the same type as @var *** 10535,10541 **** Removes trailing blank characters of a string. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 10837,10843 ---- Removes trailing blank characters of a string. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Transformational function *** 10545,10555 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STRING} @tab Shall be a scalar of type @code{CHARACTER(*)}. @end multitable @item @emph{Return value}: ! A scalar of type @code{CHARACTER(*)} which length is that of @var{STRING} less the number of trailing blanks. @item @emph{Example}: --- 10847,10857 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STRING} @tab Shall be a scalar of type @code{CHARACTER}. @end multitable @item @emph{Return value}: ! A scalar of type @code{CHARACTER} which length is that of @var{STRING} less the number of trailing blanks. @item @emph{Example}: *************** Subroutine, function *** 10593,10600 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{UNIT} @tab Shall be a scalar @code{INTEGER(*)}. ! @item @var{NAME} @tab Shall be of type @code{CHARACTER(*)}. @end multitable @item @emph{Example}: --- 10895,10902 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{UNIT} @tab Shall be a scalar @code{INTEGER}. ! @item @var{NAME} @tab Shall be of type @code{CHARACTER}. @end multitable @item @emph{Example}: *************** END PROGRAM *** 10623,10629 **** Returns the upper bounds of an array, or a single upper bound along the @var{DIM} dimension. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Inquiry function --- 10925,10931 ---- Returns the upper bounds of an array, or a single upper bound along the @var{DIM} dimension. @item @emph{Standard}: ! Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later @item @emph{Class}: Inquiry function *************** Inquiry function *** 10634,10643 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{ARRAY} @tab Shall be an array, of any type. ! @item @var{DIM} @tab (Optional) Shall be a scalar @code{INTEGER(*)}. @item @var{KIND}@tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: --- 10936,10944 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{ARRAY} @tab Shall be an array, of any type. ! @item @var{DIM} @tab (Optional) Shall be a scalar @code{INTEGER}. @item @var{KIND}@tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: *************** Subroutine *** 10678,10686 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{MASK} @tab Shall be a scalar of type @code{INTEGER(*)}. @item @var{MASK} @tab (Optional) Shall be a scalar of type ! @code{INTEGER(*)}. @end multitable @end table --- 10979,10987 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{MASK} @tab Shall be a scalar of type @code{INTEGER}. @item @var{MASK} @tab (Optional) Shall be a scalar of type ! @code{INTEGER}. @end multitable @end table *************** Subroutine, function *** 10739,10745 **** Store the elements of @var{VECTOR} in an array of higher rank. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Transformational function --- 11040,11046 ---- Store the elements of @var{VECTOR} in an array of higher rank. @item @emph{Standard}: ! Fortran 95 and later @item @emph{Class}: Transformational function *************** Transformational function *** 10752,10758 **** @item @var{VECTOR} @tab Shall be an array of any type and rank one. It shall have at least as many elements as @var{MASK} has @code{TRUE} values. @item @var{MASK} @tab Shall be an array of type @code{LOGICAL}. ! @item @var{FIELD} @tab Shall be of the sam type as @var{VECTOR} and have the same shape as @var{MASK}. @end multitable --- 11053,11059 ---- @item @var{VECTOR} @tab Shall be an array of any type and rank one. It shall have at least as many elements as @var{MASK} has @code{TRUE} values. @item @var{MASK} @tab Shall be an array of type @code{LOGICAL}. ! @item @var{FIELD} @tab Shall be of the same type as @var{VECTOR} and have the same shape as @var{MASK}. @end multitable *************** is returned. If all characters of @var{S *** 10794,10800 **** result is zero. @item @emph{Standard}: ! F95 and later @item @emph{Class}: Elemental function --- 11095,11101 ---- result is zero. @item @emph{Standard}: ! Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later @item @emph{Class}: Elemental function *************** Elemental function *** 10804,10815 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STRING} @tab Shall be of type @code{CHARACTER(*)}. ! @item @var{SET} @tab Shall be of type @code{CHARACTER(*)}. @item @var{BACK} @tab (Optional) shall be of type @code{LOGICAL}. @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of ! the result. @end multitable @item @emph{Return value}: --- 11105,11115 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{STRING} @tab Shall be of type @code{CHARACTER}. ! @item @var{SET} @tab Shall be of type @code{CHARACTER}. @item @var{BACK} @tab (Optional) shall be of type @code{LOGICAL}. @item @var{KIND} @tab (Optional) An @code{INTEGER} initialization ! expression indicating the kind parameter of the result. @end multitable @item @emph{Return value}: *************** Function *** 10858,10870 **** @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be either @code{INTEGER(*)} or @code{LOGICAL}. ! @item @var{Y} @tab The type shall be either @code{INTEGER(*)} or @code{LOGICAL}. @end multitable @item @emph{Return value}: ! The return type is either @code{INTEGER(*)} or @code{LOGICAL} ! after cross-promotion of the arguments. @item @emph{Example}: @smallexample --- 11158,11173 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .70 ! @item @var{X} @tab The type shall be either a scalar @code{INTEGER} ! type or a scalar @code{LOGICAL} type. ! @item @var{Y} @tab The type shall be the same as the type of @var{I}. @end multitable @item @emph{Return value}: ! The return type is either a scalar @code{INTEGER} or a scalar ! @code{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. @item @emph{Example}: @smallexample *************** END PROGRAM *** 10879,10885 **** @end smallexample @item @emph{See also}: ! F95 elemental function: @ref{IEOR} @end table --- 11182,11188 ---- @end smallexample @item @emph{See also}: ! Fortran 95 elemental function: @ref{IEOR} @end table *************** F95 elemental function: @ref{IEOR} *** 10892,10898 **** @section @code{ISO_FORTRAN_ENV} @table @asis @item @emph{Standard}: ! Fortran 2003 @end table The @code{ISO_FORTRAN_ENV} module provides the following scalar default-integer --- 11195,11201 ---- @section @code{ISO_FORTRAN_ENV} @table @asis @item @emph{Standard}: ! Fortran 2003 and later @end table The @code{ISO_FORTRAN_ENV} module provides the following scalar default-integer *************** named constants: *** 10903,10915 **** Size in bits of the character storage unit. @item @code{ERROR_UNIT}: ! Indentifies the preconnected unit used for error reporting. @item @code{FILE_STORAGE_SIZE}: Size in bits of the file-storage unit. @item @code{INPUT_UNIT}: ! Indentifies the preconnected unit indentified by the asterisk (@code{*}) in @code{READ} statement. @item @code{IOSTAT_END}: --- 11206,11218 ---- Size in bits of the character storage unit. @item @code{ERROR_UNIT}: ! Identifies the preconnected unit used for error reporting. @item @code{FILE_STORAGE_SIZE}: Size in bits of the file-storage unit. @item @code{INPUT_UNIT}: ! Identifies the preconnected unit identified by the asterisk (@code{*}) in @code{READ} statement. @item @code{IOSTAT_END}: *************** an input/output statement if an end-of-r *** 10924,10930 **** The size in bits of the numeric storage unit. @item @code{OUTPUT_UNIT}: ! Indentifies the preconnected unit indentified by the asterisk (@code{*}) in @code{WRITE} statement. @end table --- 11227,11233 ---- The size in bits of the numeric storage unit. @item @code{OUTPUT_UNIT}: ! Identifies the preconnected unit identified by the asterisk (@code{*}) in @code{WRITE} statement. @end table *************** Indentifies the preconnected unit indent *** 10932,10938 **** @section @code{ISO_C_BINDING} @table @asis @item @emph{Standard}: ! Fortran 2003 @end table The following intrinsic procedures are provided by the module; their --- 11235,11241 ---- @section @code{ISO_C_BINDING} @table @asis @item @emph{Standard}: ! Fortran 2003 and later, GNU extensions @end table The following intrinsic procedures are provided by the module; their *************** manual. *** 10946,10961 **** @item @code{C_FUNLOC} @item @code{C_LOC} @end table The @code{ISO_C_BINDING} module provides the following named constants of the type integer, which can be used as KIND type parameter. Note that GNU Fortran currently does not support the @code{C_INT_FAST...} KIND type ! parameters (marked by an asterix (@code{*}) in the list below). The @code{C_INT_FAST...} parameters have therefore the value @math{-2} and cannot be used as KIND type parameter of the @code{INTEGER} type. ! @multitable @columnfractions .15 .35 .35 ! @item Fortran Type @tab Named constant @tab C type @item @code{INTEGER}@tab @code{C_INT} @tab @code{int} @item @code{INTEGER}@tab @code{C_SHORT} @tab @code{short int} @item @code{INTEGER}@tab @code{C_LONG} @tab @code{long int} --- 11249,11271 ---- @item @code{C_FUNLOC} @item @code{C_LOC} @end table + @c TODO: Vertical spacing between C_FUNLOC and C_LOC wrong in PDF, + @c don't really know why. The @code{ISO_C_BINDING} module provides the following named constants of the type integer, which can be used as KIND type parameter. Note that GNU Fortran currently does not support the @code{C_INT_FAST...} KIND type ! parameters (marked by an asterisk (@code{*}) in the list below). The @code{C_INT_FAST...} parameters have therefore the value @math{-2} and cannot be used as KIND type parameter of the @code{INTEGER} type. ! In addition to the integer named constants required by the Fortran 2003 ! standard, GNU Fortran provides as an extension named constants for the ! 128-bit integer types supported by the C compiler: @code{C_INT128_T, ! C_INT_LEAST128_T, C_INT_FAST128_T}. ! ! @multitable @columnfractions .15 .35 .35 .35 ! @item Fortran Type @tab Named constant @tab C type @tab Extension @item @code{INTEGER}@tab @code{C_INT} @tab @code{int} @item @code{INTEGER}@tab @code{C_SHORT} @tab @code{short int} @item @code{INTEGER}@tab @code{C_LONG} @tab @code{long int} *************** and cannot be used as KIND type paramete *** 10966,10979 **** --- 11276,11292 ---- @item @code{INTEGER}@tab @code{C_INT16_T} @tab @code{int16_t} @item @code{INTEGER}@tab @code{C_INT32_T} @tab @code{int32_t} @item @code{INTEGER}@tab @code{C_INT64_T} @tab @code{int64_t} + @item @code{INTEGER}@tab @code{C_INT128_T} @tab @code{int128_t} @tab Ext. @item @code{INTEGER}@tab @code{C_INT_LEAST8_T} @tab @code{int_least8_t} @item @code{INTEGER}@tab @code{C_INT_LEAST16_T} @tab @code{int_least16_t} @item @code{INTEGER}@tab @code{C_INT_LEAST32_T} @tab @code{int_least32_t} @item @code{INTEGER}@tab @code{C_INT_LEAST64_T} @tab @code{int_least64_t} + @item @code{INTEGER}@tab @code{C_INT_LEAST128_T} @tab @code{int_least128_t} @tab Ext. @item @code{INTEGER}@tab @code{C_INT_FAST8_T}* @tab @code{int_fast8_t} @item @code{INTEGER}@tab @code{C_INT_FAST16_T}* @tab @code{int_fast16_t} @item @code{INTEGER}@tab @code{C_INT_FAST32_T}* @tab @code{int_fast32_t} @item @code{INTEGER}@tab @code{C_INT_FAST64_T}* @tab @code{int_fast64_t} + @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{REAL} @tab @code{C_FLOAT} @tab @code{float} *************** and cannot be used as KIND type paramete *** 10986,10992 **** @item @code{CHARACTER}@tab @code{C_CHAR} @tab @code{char} @end multitable ! Additionally, the following @code{(CHARACTER(KIND=C_CHAR)} are defined. @multitable @columnfractions .20 .45 .15 --- 11299,11305 ---- @item @code{CHARACTER}@tab @code{C_CHAR} @tab @code{char} @end multitable ! Additionally, the following @code{(CHARACTER(KIND=C_CHAR))} are defined. @multitable @columnfractions .20 .45 .15 *************** defined. *** 11005,11011 **** @section OpenMP Modules @code{OMP_LIB} and @code{OMP_LIB_KINDS} @table @asis @item @emph{Standard}: ! OpenMP Application Program Interface v2.5 @end table --- 11318,11324 ---- @section OpenMP Modules @code{OMP_LIB} and @code{OMP_LIB_KINDS} @table @asis @item @emph{Standard}: ! OpenMP Application Program Interface v3.0 @end table *************** the named constants defined in the @code *** 11018,11025 **** below. For details refer to the actual ! @uref{http://www.openmp.org/drupal/mp-documents/spec25.pdf, ! OpenMP Application Program Interface v2.5}. @code{OMP_LIB_KINDS} provides the following scalar default-integer named constants: --- 11331,11338 ---- below. For details refer to the actual ! @uref{http://www.openmp.org/mp-documents/spec30.pdf, ! OpenMP Application Program Interface v3.0}. @code{OMP_LIB_KINDS} provides the following scalar default-integer named constants: *************** named constants: *** 11029,11032 **** --- 11342,11346 ---- @item @code{omp_logical_kind} @item @code{omp_lock_kind} @item @code{omp_nest_lock_kind} + @item @code{omp_sched_kind} @end table diff -Nrcpad gcc-4.3.3/gcc/fortran/invoke.texi gcc-4.4.0/gcc/fortran/invoke.texi *** gcc-4.3.3/gcc/fortran/invoke.texi Tue Jan 22 07:33:46 2008 --- gcc-4.4.0/gcc/fortran/invoke.texi Sun Dec 21 18:45:17 2008 *************** *** 1,21 **** ! @c Copyright (C) 2004, 2005, 2006, 2007 @c 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, 2005, 2006, 2007 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.2 or any later version published by the Free Software Foundation; with the ! Invariant Sections being ``GNU General Public License'' and ``Funding ! Free Software'', the Front-Cover texts being (a) (see below), and with ! the Back-Cover Texts being (b) (see below). A copy of the license is ! included in the gfdl(7) man page. ! (a) The FSF's Front-Cover Text is: A GNU Manual --- 1,20 ---- ! @c Copyright (C) 2004, 2005, 2006, 2007, 2008 @c 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, 2005, 2006, 2007, 2008 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.2 or any later version published by the Free Software Foundation; with the ! Invariant Sections being ``Funding Free Software'', the Front-Cover ! Texts being (a) (see below), and with the Back-Cover Texts being (b) ! (see below). A copy of the license is included in the gfdl(7) man page. ! (a) The FSF's Front-Cover Text is: A GNU Manual *************** gfortran [@option{-c}|@option{-S}|@optio *** 36,42 **** [@option{-I}@var{dir}@dots{}] [@option{-L}@var{dir}@dots{}] [@option{-D}@var{macro}[=@var{defn}]@dots{}] [@option{-U}@var{macro}] [@option{-f}@var{option}@dots{}] ! [@option{-m}@var{machine-option}@dots{}] [@option{-o} @var{outfile}] @var{infile}@dots{} Only the most useful options are listed here; see below for the --- 35,41 ---- [@option{-I}@var{dir}@dots{}] [@option{-L}@var{dir}@dots{}] [@option{-D}@var{macro}[=@var{defn}]@dots{}] [@option{-U}@var{macro}] [@option{-f}@var{option}@dots{}] ! [@option{-m}@var{machine-option}@dots{}] [@option{-o} @var{outfile}] @var{infile}@dots{} Only the most useful options are listed here; see below for the *************** one is not the default. *** 94,99 **** --- 93,99 ---- without explanations. * Fortran Dialect Options:: Controlling the variant of Fortran language compiled. + * Preprocessing Options:: Enable and customize preprocessing. * Error and Warning Options:: How picky should the compiler be? * Debugging Options:: Symbol tables, measurements, and debugging dumps. * Directory Options:: Where to find module files *************** by type. Explanations are in the follow *** 123,136 **** -fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 @gol -fcray-pointer -fopenmp -fno-range-check -fbackslash -fmodule-private} @item Error and Warning Options @xref{Error and Warning Options,,Options to request or suppress errors and warnings}. @gccoptlist{-fmax-errors=@var{n} @gol -fsyntax-only -pedantic -pedantic-errors @gol ! -Wall -Waliasing -Wampersand -Wcharacter-truncation -Wconversion @gol ! -Wimplicit-interface -Wline-truncation -Wnonstd-intrinsics -Wsurprising @gol ! -Wno-tabs -Wunderflow -Wunused-parameter} @item Debugging Options @xref{Debugging Options,,Options for debugging your program or GNU Fortran}. --- 123,145 ---- -fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 @gol -fcray-pointer -fopenmp -fno-range-check -fbackslash -fmodule-private} + @item Preprocessing Options + @xref{Preprocessing Options,,Enable and customize preprocessing}. + @gccoptlist{-cpp -dD -dI -dM -dN -dU -fworking-directory @gol + -imultilib @var{dir} -iprefix @var{file} -isysroot @var{dir} @gol + -iquote -isystem @var{dir} -nocpp -nostdinc -undef @gol + -A@var{question}=@var{answer} -A-@var{question}@r{[}=@var{answer}@r{]} @gol + -C -CC -D@var{macro}@r{[}=@var{defn}@r{]} -U@var{macro} -H -P} + @item Error and Warning Options @xref{Error and Warning Options,,Options to request or suppress errors and warnings}. @gccoptlist{-fmax-errors=@var{n} @gol -fsyntax-only -pedantic -pedantic-errors @gol ! -Wall -Waliasing -Wampersand -Warray-bounds -Wcharacter-truncation @gol ! -Wconversion -Wimplicit-interface -Wline-truncation -Wintrinsics-std @gol ! -Wsurprising -Wno-tabs -Wunderflow -Wunused-parameter -Wintrinsics-shadow @gol ! -Wno-align-commons} @item Debugging Options @xref{Debugging Options,,Options for debugging your program or GNU Fortran}. *************** and warnings}. *** 139,145 **** @item Directory Options @xref{Directory Options,,Options for directory search}. ! @gccoptlist{-I@var{dir} -J@var{dir} -M@var{dir} -fintrinsic-modules-path @var{dir}} @item Link Options @xref{Link Options,,Options for influencing the linking step}. --- 148,155 ---- @item Directory Options @xref{Directory Options,,Options for directory search}. ! @gccoptlist{-I@var{dir} -J@var{dir} -M@var{dir} @gol ! -fintrinsic-modules-path @var{dir}} @item Link Options @xref{Link Options,,Options for influencing the linking step}. *************** and warnings}. *** 147,169 **** @item Runtime Options @xref{Runtime Options,,Options for influencing runtime behavior}. ! @gccoptlist{-fconvert=@var{conversion} -frecord-marker=@var{length} @gol ! -fmax-subrecord-length=@var{length} -fsign-zero} @item Code Generation Options @xref{Code Gen Options,,Options for code generation conventions}. ! @gccoptlist{-fno-automatic -ff2c -fno-underscoring -fsecond-underscore @gol ! -fbounds-check -fmax-stack-var-size=@var{n} @gol -fpack-derived -frepack-arrays -fshort-enums -fexternal-blas @gol -fblas-matmul-limit=@var{n} -frecursive -finit-local-zero @gol -finit-integer=@var{n} -finit-real=@var{} @gol ! -finit-logical=@var{} -finit-character=@var{n}} @end table @menu * Fortran Dialect Options:: Controlling the variant of Fortran language compiled. * Error and Warning Options:: How picky should the compiler be? * Debugging Options:: Symbol tables, measurements, and debugging dumps. * Directory Options:: Where to find module files --- 157,182 ---- @item Runtime Options @xref{Runtime Options,,Options for influencing runtime behavior}. ! @gccoptlist{-fconvert=@var{conversion} -fno-range-check ! -frecord-marker=@var{length} @gol -fmax-subrecord-length=@var{length} ! -fsign-zero} @item Code Generation Options @xref{Code Gen Options,,Options for code generation conventions}. ! @gccoptlist{-fno-automatic -ff2c -fno-underscoring @gol -fsecond-underscore @gol ! -fbounds-check -fcheck-array-temporaries -fmax-array-constructor =@var{n} @gol ! -fmax-stack-var-size=@var{n} @gol -fpack-derived -frepack-arrays -fshort-enums -fexternal-blas @gol -fblas-matmul-limit=@var{n} -frecursive -finit-local-zero @gol -finit-integer=@var{n} -finit-real=@var{} @gol ! -finit-logical=@var{} -finit-character=@var{n} -fno-align-commons} @end table @menu * Fortran Dialect Options:: Controlling the variant of Fortran language compiled. + * Preprocessing Options:: Enable and customize preprocessing. * Error and Warning Options:: How picky should the compiler be? * Debugging Options:: Symbol tables, measurements, and debugging dumps. * Directory Options:: Where to find module files *************** form is determined by the file extension *** 197,206 **** @item -fall-intrinsics @opindex @code{fall-intrinsics} ! Accept all of the intrinsic procedures provided in libgfortran ! without regard to the setting of @option{-std}. In particular, ! this option can be quite useful with @option{-std=f95}. Additionally, ! @command{gfortran} will ignore @option{-Wnonstd-intrinsics}. @item -fd-lines-as-code @item -fd-lines-as-comments --- 210,221 ---- @item -fall-intrinsics @opindex @code{fall-intrinsics} ! This option causes all intrinsic procedures (including the GNU-specific ! extensions) to be accepted. This can be useful with @option{-std=f95} to ! force standard-compliance but get access to the full range of intrinsics ! available with @command{gfortran}. As a consequence, @option{-Wintrinsics-std} ! will be ignored and no user-defined procedure with the same name as any ! intrinsic will be called except when it is explicitly declared @code{EXTERNAL}. @item -fd-lines-as-code @item -fd-lines-as-comments *************** comment lines. *** 214,230 **** @item -fdefault-double-8 @opindex @code{fdefault-double-8} ! Set the @code{DOUBLE PRECISION} type to an 8 byte wide type. @item -fdefault-integer-8 @opindex @code{fdefault-integer-8} Set the default integer and logical types to an 8 byte wide type. ! Do nothing if this is already the default. @item -fdefault-real-8 @opindex @code{fdefault-real-8} Set the default real type to an 8 byte wide type. ! Do nothing if this is already the default. @item -fdollar-ok @opindex @code{fdollar-ok} --- 229,254 ---- @item -fdefault-double-8 @opindex @code{fdefault-double-8} ! Set the @code{DOUBLE PRECISION} type to an 8 byte wide type. If ! @option{-fdefault-real-8} is given, @code{DOUBLE PRECISION} would ! instead be promoted to 16 bytes if possible, and @option{-fdefault-double-8} ! can be used to prevent this. The kind of real constants like @code{1.d0} will ! not be changed by @option{-fdefault-real-8} though, so also ! @option{-fdefault-double-8} does not affect it. @item -fdefault-integer-8 @opindex @code{fdefault-integer-8} Set the default integer and logical types to an 8 byte wide type. ! Do nothing if this is already the default. This option also affects ! the kind of integer constants like @code{42}. @item -fdefault-real-8 @opindex @code{fdefault-real-8} Set the default real type to an 8 byte wide type. ! Do nothing if this is already the default. This option also affects ! the kind of non-double real constants like @code{1.0}, and does promote ! the default width of @code{DOUBLE PRECISION} to 16 bytes if possible, unless ! @code{-fdefault-double-8} is given, too. @item -fdollar-ok @opindex @code{fdollar-ok} *************** Allow @samp{$} as a valid character in a *** 237,249 **** @opindex @code{backslash} @cindex backslash @cindex escape characters ! 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, backspace, form feed, ! newline, carriage return, horizontal tab, vertical tab, backslash, ! and NUL, respectively. All other combinations of a character preceded ! by \ are unexpanded. @item -fmodule-private @opindex @code{fmodule-private} --- 261,277 ---- @opindex @code{backslash} @cindex backslash @cindex escape characters ! Change the interpretation of backslashes in string literals from a single ! backslash character to ``C-style'' escape characters. The following ! combinations are expanded @code{\a}, @code{\b}, @code{\f}, @code{\n}, ! @code{\r}, @code{\t}, @code{\v}, @code{\\}, and @code{\0} to the ASCII ! characters alert, backspace, form feed, newline, carriage return, ! horizontal tab, vertical tab, backslash, and NUL, respectively. ! Additionally, @code{\x}@var{nn}, @code{\u}@var{nnnn} and ! @code{\U}@var{nnnnnnnn} (where each @var{n} is a hexadecimal digit) are ! translated into the Unicode characters corresponding to the specified code ! points. All other combinations of a character preceded by \ are ! unexpanded. @item -fmodule-private @opindex @code{fmodule-private} *************** lines in the source file. The default va *** 281,287 **** @item -fmax-identifier-length=@var{n} @opindex @code{fmax-identifier-length=}@var{n} Specify the maximum allowed identifier length. Typical values are ! 31 (Fortran 95) and 63 (Fortran 2003). @item -fimplicit-none @opindex @code{fimplicit-none} --- 309,315 ---- @item -fmax-identifier-length=@var{n} @opindex @code{fmax-identifier-length=}@var{n} Specify the maximum allowed identifier length. Typical values are ! 31 (Fortran 95) and 63 (Fortran 2003 and Fortran 2008). @item -fimplicit-none @opindex @code{fimplicit-none} *************** on most systems, but with @option{-fno-r *** 322,342 **** @item -std=@var{std} @opindex @code{std=}@var{std} option Specify the standard to which the program is expected to conform, which ! may be one of @samp{f95}, @samp{f2003}, @samp{gnu}, or @samp{legacy}. ! The default value for @var{std} is @samp{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 @samp{legacy} value ! is equivalent but without the warnings for obsolete extensions, and may ! be useful for old non-standard programs. The @samp{f95} and ! @samp{f2003} values specify strict conformance to the Fortran 95 and ! Fortran 2003 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. @end table @node Error and Warning Options @section Options to request or suppress errors and warnings @cindex options, warnings --- 350,611 ---- @item -std=@var{std} @opindex @code{std=}@var{std} option Specify the standard to which the program is expected to conform, which ! may be one of @samp{f95}, @samp{f2003}, @samp{f2008}, @samp{gnu}, or ! @samp{legacy}. The default value for @var{std} is @samp{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 ! @samp{legacy} value is equivalent but without the warnings for obsolete ! extensions, and may be useful for old non-standard programs. The ! @samp{f95}, @samp{f2003} and @samp{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. @end table + @node Preprocessing Options + @section Enable and customize preprocessing + @cindex preprocessor + @cindex options, preprocessor + @cindex CPP + + Preprocessor related options. See section + @ref{Preprocessing and conditional compilation} for more detailed + information on preprocessing in @command{gfortran}. + + @table @gcctabopt + @item -cpp + @item -nocpp + @opindex @code{cpp} + @opindex @code{fpp} + @cindex preprocessor, enable + @cindex preprocessor, disable + Enable preprocessing. The preprocessor is automatically invoked if + the file extension is @file{.fpp}, @file{.FPP}, @file{.F}, @file{.FOR}, + @file{.FTN}, @file{.F90}, @file{.F95}, @file{.F03} or @file{.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: @option{-nocpp}. + + The preprocessor is run in traditional mode, be aware that any + restrictions of the file-format, e.g. fixed-form line width, + apply for preprocessed output as well. + + @item -dM + @opindex @code{dM} + @cindex preprocessor, debugging + @cindex debugging, preprocessor + Instead of the normal output, generate a list of @code{'#define'} + directives for all the macros defined during the execution of the + 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 @file{foo.f90}, the command + @smallexample + touch foo.f90; gfortran -cpp -dM foo.f90 + @end smallexample + will show all the predefined macros. + + @item -dD + @opindex @code{dD} + @cindex preprocessor, debugging + @cindex debugging, preprocessor + Like @option{-dM} except in two respects: it does not include the + predefined macros, and it outputs both the @code{#define} directives + and the result of preprocessing. Both kinds of output go to the + standard output file. + + @item -dN + @opindex @code{dN} + @cindex preprocessor, debugging + @cindex debugging, preprocessor + Like @option{-dD}, but emit only the macro names, not their expansions. + + @item -dU + @opindex @code{dU} + @cindex preprocessor, debugging + @cindex debugging, preprocessor + Like @option{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 @code{'#undef'} + directives are also output for macros tested but undefined at the time. + + @item -dI + @opindex @code{dI} + @cindex preprocessor, debugging + @cindex debugging, preprocessor + Output @code{'#include'} directives in addition to the result + of preprocessing. + + @item -fworking-directory + @opindex @code{fworking-directory} + @cindex preprocessor, working 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 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's 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 + @option{-fno-working-directory}. If the @option{-P} flag is present + in the command line, this option has no effect, since no @code{#line} + directives are emitted whatsoever. + + @item -idirafter @var{dir} + @opindex @code{idirafter @var{dir}} + @cindex preprocessing, include path + Search @var{dir} for include files, but do it after all directories + specified with @option{-I} and the standard system directories have + been exhausted. @var{dir} is treated as a system include directory. + If dir begins with @code{=}, then the @code{=} will be replaced by + the sysroot prefix; see @option{--sysroot} and @option{-isysroot}. + + @item -imultilib @var{dir} + @opindex @code{imultilib @var{dir}} + @cindex preprocessing, include path + Use @var{dir} as a subdirectory of the directory containing target-specific + C++ headers. + + @item -iprefix @var{prefix} + @opindex @code{iprefix @var{prefix}} + @cindex preprocessing, include path + Specify @var{prefix} as the prefix for subsequent @option{-iwithprefix} + options. If the @var{prefix} represents a directory, you should include + the final @code{'/'}. + + @item -isysroot @var{dir} + @opindex @code{isysroot @var{dir}} + @cindex preprocessing, include path + This option is like the @option{--sysroot} option, but applies only to + header files. See the @option{--sysroot} option for more information. + + @item -iquote @var{dir} + @opindex @code{iquote @var{dir}} + @cindex preprocessing, include path + Search @var{dir} only for header files requested with @code{#include "file"}; + they are not searched for @code{#include }, before all directories + specified by @option{-I} and before the standard system directories. If + @var{dir} begins with @code{=}, then the @code{=} will be replaced by the + sysroot prefix; see @option{--sysroot} and @option{-isysroot}. + + @item -isystem @var{dir} + @opindex @code{isystem @var{dir}} + @cindex preprocessing, include path + Search @var{dir} for header files, after all directories specified by + @option{-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 @var{dir} begins with + @code{=}, then the @code{=} will be replaced by the sysroot prefix; + see @option{--sysroot} and @option{-isysroot}. + + @item -nostdinc + @opindex @code{nostdinc} + Do not search the standard system directories for header files. Only + the directories you have specified with @option{-I} options (and the + directory of the current file, if appropriate) are searched. + + @item -undef + @opindex @code{undef} + Do not predefine any system-specific or GCC-specific macros. + The standard predefined macros remain defined. + + @item -A@var{predicate}=@var{answer} + @opindex @code{A@var{predicate}=@var{answer}} + @cindex preprocessing, assertation + Make an assertion with the predicate @var{predicate} and answer @var{answer}. + This form is preferred to the older form -A predicate(answer), which is still + supported, because it does not use shell special characters. + + @item -A-@var{predicate}=@var{answer} + @opindex @code{A-@var{predicate}=@var{answer}} + @cindex preprocessing, assertation + Cancel an assertion with the predicate @var{predicate} and answer @var{answer}. + + @item -C + @opindex @code{C} + @cindex preprocessing, keep comments + 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 @option{-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 @code{'#'}. + + Warning: this currently handles C-Style comments only. The preprocessor + does not yet recognize Fortran-style comments. + + @item -CC + @opindex @code{CC} + @cindex preprocessing, keep comments + Do not discard comments, including during macro expansion. This is like + @option{-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 @option{-C} option, the @option{-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 @option{-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. + + @item -D@var{name} + @opindex @code{D@var{name}} + @cindex preprocessing, define macros + Predefine name as a macro, with definition @code{1}. + + @item -D@var{name}=@var{definition} + @opindex @code{D@var{name}=@var{definition}} + @cindex preprocessing, define macros + The contents of @var{definition} are tokenized and processed as if they + appeared during translation phase three in a @code{'#define'} directive. + In particular, the definition will be truncated by embedded newline + characters. + + If you are invoking the preprocessor from a shell or shell-like program + you may need to use the shell's quoting syntax to protect characters such + as spaces that have a meaning in the shell syntax. + + 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, @code{-D'name(args...)=definition'} + works. + + @option{-D} and @option{-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. + + @item -H + @opindex @code{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 @code{'#include'} + stack it is. + + @item -P + @opindex @code{P} + @cindex preprocessing, no linemarkers + 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. + + @item -U@var{name} + @opindex @code{U@var{name}} + @cindex preprocessing, undefine macros + Cancel any previous definition of @var{name}, either built in or provided + with a @option{-D} option. + @end table + + @node Error and Warning Options @section Options to request or suppress errors and warnings @cindex options, warnings *************** They soon find that it does not do quite *** 400,407 **** nonstandard practices, but not all. However, improvements to GNU Fortran in this area are welcome. ! This should be used in conjunction with @option{-std=f95} or ! @option{-std=f2003}. @item -pedantic-errors @opindex @code{pedantic-errors} --- 669,676 ---- nonstandard practices, but not all. However, improvements to GNU Fortran in this area are welcome. ! This should be used in conjunction with @option{-std=f95}, ! @option{-std=f2003} or @option{-std=f2008}. @item -pedantic-errors @opindex @code{pedantic-errors} *************** warnings. *** 415,422 **** Enables commonly used warning options pertaining to usage that we recommend avoiding and that we believe are easy to avoid. This currently includes @option{-Waliasing}, ! @option{-Wampersand}, @option{-Wsurprising}, @option{-Wnonstd-intrinsics}, ! @option{-Wno-tabs}, and @option{-Wline-truncation}. @item -Waliasing @opindex @code{Waliasing} --- 684,691 ---- Enables commonly used warning options pertaining to usage that we recommend avoiding and that we believe are easy to avoid. This currently includes @option{-Waliasing}, ! @option{-Wampersand}, @option{-Wsurprising}, @option{-Wintrinsics-std}, ! @option{-Wno-tabs}, @option{-Wintrinsic-shadow} and @option{-Wline-truncation}. @item -Waliasing @opindex @code{Waliasing} *************** The following example will trigger the w *** 445,460 **** @cindex warnings, ampersand @cindex & Warn about missing ampersand in continued character constants. The warning is ! given with @option{-Wampersand}, @option{-pedantic}, @option{-std=f95}, and ! @option{-std=f2003}. 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. @item -Wcharacter-truncation @opindex @code{Wcharacter-truncation} @cindex warnings, character truncation Warn when a character assignment will truncate the assigned string. @item -Wconversion @opindex @code{Wconversion} @cindex warnings, conversion --- 714,742 ---- @cindex warnings, ampersand @cindex & Warn about missing ampersand in continued character constants. The warning is ! given with @option{-Wampersand}, @option{-pedantic}, @option{-std=f95}, ! @option{-std=f2003} and @option{-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. ! ! @item -Warray-temporaries ! @opindex @code{Warray-temporaries} ! @cindex warnings, array 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. @item -Wcharacter-truncation @opindex @code{Wcharacter-truncation} @cindex warnings, character truncation Warn when a character assignment will truncate the assigned string. + @item -Wline-truncation + @opindex @code{Wline-truncation} + @cindex warnings, line truncation + Warn when a source code line will be truncated. + @item -Wconversion @opindex @code{Wconversion} @cindex warnings, conversion *************** Warn if a procedure is called without an *** 468,478 **** Note this only checks that an explicit interface is present. It does not check that the declared interfaces are consistent across program units. ! @item -Wnonstd-intrinsics ! @opindex @code{Wnonstd-intrinsics} @cindex warnings, non-standard intrinsics ! Warn if the user tries to use an intrinsic that does not belong to the ! standard the user has chosen via the @option{-std} option. @item -Wsurprising @opindex @code{Wsurprising} --- 750,764 ---- Note this only checks that an explicit interface is present. It does not check that the declared interfaces are consistent across program units. ! @item -Wintrinsics-std ! @opindex @code{Wintrinsics-std} @cindex warnings, non-standard intrinsics ! @cindex warnings, intrinsics of other standards ! Warn if @command{gfortran} finds a procedure named like an intrinsic not ! available in the currently selected standard (with @option{-std}) and treats ! it as @code{EXTERNAL} procedure because of this. @option{-fall-intrinsics} can ! be used to never trigger this behaviour and always link to the intrinsic ! regardless of the selected standard. @item -Wsurprising @opindex @code{Wsurprising} *************** A LOGICAL SELECT construct has three CAS *** 492,497 **** --- 778,787 ---- @item A TRANSFER specifies a source that is shorter than the destination. + + @item + The type of a function result is declared more than once with the same type. If + @option{-pedantic} or standard-conforming mode is enabled, this is an error. @end itemize @item -Wtabs *************** of the Fortran Character Set. For conti *** 503,509 **** by a digit between 1 and 9 is supported. @option{-Wno-tabs} will cause a warning to be issued if a tab is encountered. Note, @option{-Wno-tabs} is active for @option{-pedantic}, @option{-std=f95}, @option{-std=f2003}, ! and @option{-Wall}. @item -Wunderflow @opindex @code{Wunderflow} --- 793,799 ---- by a digit between 1 and 9 is supported. @option{-Wno-tabs} will cause a warning to be issued if a tab is encountered. Note, @option{-Wno-tabs} is active for @option{-pedantic}, @option{-std=f95}, @option{-std=f2003}, ! @option{-std=f2008} and @option{-Wall}. @item -Wunderflow @opindex @code{Wunderflow} *************** and @option{-Wall}. *** 512,517 **** --- 802,816 ---- Produce a warning when numerical constant expressions are encountered, which yield an UNDERFLOW during compilation. + @item -Wintrinsic-shadow + @opindex @code{Wintrinsic-shadow} + @cindex warnings, intrinsic + @cindex intrinsic + Warn if a user-defined procedure or module procedure has the same name as an + intrinsic; in this case, an explicit interface or @code{EXTERNAL} or + @code{INTRINSIC} declaration might be needed to get calls later resolved to + the desired intrinsic/procedure. + @item -Wunused-parameter @opindex @code{Wunused-parameter} @cindex warnings, unused parameter *************** about unused dummy arguments, but about *** 522,527 **** --- 821,834 ---- @option{-Wunused-parameter} is not included in @option{-Wall} but is implied by @option{-Wall -Wextra}. + @item -Walign-commons + @opindex @code{Walign-commons} + @cindex warnings, alignment of COMMON blocks + @cindex alignment of COMMON blocks + By default, @command{gfortran} warns about any occasion of variables being + padded for proper alignment inside a COMMON block. This warning can be turned + off via @option{-Wno-align-commons}. See also @option{-falign-commons}. + @item -Werror @opindex @code{Werror} @cindex warnings, to errors *************** zero), @samp{overflow} (overflow in a fl *** 563,569 **** (operation produced a denormal value). Some of the routines in the Fortran runtime library, like ! @samp{CPU_TIME}, are likely to to trigger floating point exceptions when @code{ffpe-trap=precision} is used. For this reason, the use of @code{ffpe-trap=precision} is not recommended. --- 870,876 ---- (operation produced a denormal value). Some of the routines in the Fortran runtime library, like ! @samp{CPU_TIME}, are likely to trigger floating point exceptions when @code{ffpe-trap=precision} is used. For this reason, the use of @code{ffpe-trap=precision} is not recommended. *************** compiled modules are required by a @code *** 627,636 **** gcc,Using the GNU Compiler Collection (GCC)}, for information on the @option{-I} option. - @item -M@var{dir} @item -J@var{dir} ! @opindex @code{M}@var{dir} @opindex @code{J}@var{dir} @cindex paths, search @cindex module search path This option specifies where to put @file{.mod} files for compiled modules. --- 934,943 ---- gcc,Using the GNU Compiler Collection (GCC)}, for information on the @option{-I} option. @item -J@var{dir} ! @item -M@var{dir} @opindex @code{J}@var{dir} + @opindex @code{M}@var{dir} @cindex paths, search @cindex module search path This option specifies where to put @file{.mod} files for compiled modules. *************** statement. *** 639,646 **** The default is the current directory. ! @option{-J} is an alias for @option{-M} to avoid conflicts with existing ! GCC options. @item -fintrinsic-modules-path @var{dir} @opindex @code{fintrinsic-modules-path} @var{dir} --- 946,952 ---- The default is the current directory. ! @option{-M} is deprecated to avoid conflicts with existing GCC options. @item -fintrinsic-modules-path @var{dir} @opindex @code{fintrinsic-modules-path} @var{dir} *************** representation for unformatted files. *** 687,692 **** --- 993,1008 ---- The @code{CONVERT} specifier and the GFORTRAN_CONVERT_UNIT environment variable override the default specified by @option{-fconvert}.} + + @item -fno-range-check + @opindex @code{fno-range-check} + Disable range checking of input values during integer @code{READ} operations. + For example, GNU Fortran will give an error if an input value is + outside of the relevant range of [@code{-HUGE()}:@code{HUGE()}]. In other words, + with @code{INTEGER (kind=4) :: i} , attempting to read @math{-2147483648} will + give an error unless @option{-fno-range-check} is given. + + @item -frecord-marker=@var{length} @opindex @code{frecord-marker=}@var{length} Specify the length of record markers for unformatted files. *************** by use of the @option{-ff2c} option. *** 876,888 **** 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 against the actual allocated bounds. Some checks require that @option{-fbounds-check} is set for the compilation of the main program. ! In the future this may also include other forms of checking, e.g., checking ! substring references. @item -fmax-stack-var-size=@var{n} @opindex @code{fmax-stack-var-size} --- 1192,1239 ---- 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 against the actual allocated bounds and ensures that all string ! lengths are equal for character array constructors without an explicit ! typespec. Some checks require that @option{-fbounds-check} 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. ! ! ! @item fcheck-array-temporaries ! @opindex @code{fcheck-array-temporaries} ! @cindex checking array temporaries ! 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. ! ! Note: The warning is only printed once per location. ! ! ! @item -fmax-array-constructor=@var{n} ! @opindex @code{fmax-array-constructor} ! 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. ! ! @smallexample ! @code{program test} ! @code{implicit none} ! @code{integer j} ! @code{integer, parameter :: n = 100000} ! @code{integer, parameter :: i(n) = (/ (2*j, j = 1, n) /)} ! @code{print '(10(I0,1X))', i} ! @code{end program test} ! @end smallexample ! ! @emph{Caution: This option can lead to long compile times and excessively ! large object files.} ! ! The default value for @var{n} is 65535. ! @item -fmax-stack-var-size=@var{n} @opindex @code{fmax-stack-var-size} *************** future releases). *** 977,982 **** --- 1328,1345 ---- Note that the @option{-finit-real=nan} option initializes @code{REAL} and @code{COMPLEX} variables with a quiet NaN. + + @item -falign-commons + @opindex @code{falign-commons} + @cindex alignment of COMMON blocks + By default, @command{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 everywhere, this padding can cause trouble, and + @option{-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 largests to smallest. @end table @xref{Code Gen Options,,Options for Code Generation Conventions, diff -Nrcpad gcc-4.3.3/gcc/fortran/io.c gcc-4.4.0/gcc/fortran/io.c *** gcc-4.3.3/gcc/fortran/io.c Sun Jan 6 09:21:27 2008 --- gcc-4.4.0/gcc/fortran/io.c Sun Dec 21 21:20:29 2008 *************** *** 1,5 **** /* Deal with I/O statements & related stuff. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Deal with I/O statements & related stuff. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Andy Vaught *************** format_asterisk = {0, NULL, NULL, -1, ST *** 32,88 **** typedef struct { ! const char *name, *spec; bt type; } io_tag; static const io_tag ! tag_file = { "FILE", " file = %e", BT_CHARACTER }, ! tag_status = { "STATUS", " status = %e", BT_CHARACTER}, ! tag_e_access = {"ACCESS", " access = %e", BT_CHARACTER}, ! tag_e_form = {"FORM", " form = %e", BT_CHARACTER}, ! tag_e_recl = {"RECL", " recl = %e", BT_INTEGER}, ! tag_e_blank = {"BLANK", " blank = %e", BT_CHARACTER}, ! tag_e_position = {"POSITION", " position = %e", BT_CHARACTER}, ! tag_e_action = {"ACTION", " action = %e", BT_CHARACTER}, ! tag_e_delim = {"DELIM", " delim = %e", BT_CHARACTER}, ! tag_e_pad = {"PAD", " pad = %e", BT_CHARACTER}, ! tag_unit = {"UNIT", " unit = %e", BT_INTEGER}, ! tag_advance = {"ADVANCE", " advance = %e", BT_CHARACTER}, ! tag_rec = {"REC", " rec = %e", BT_INTEGER}, ! tag_spos = {"POSITION", " pos = %e", BT_INTEGER}, ! tag_format = {"FORMAT", NULL, BT_CHARACTER}, ! tag_iomsg = {"IOMSG", " iomsg = %e", BT_CHARACTER}, ! tag_iostat = {"IOSTAT", " iostat = %v", BT_INTEGER}, ! tag_size = {"SIZE", " size = %v", BT_INTEGER}, ! tag_exist = {"EXIST", " exist = %v", BT_LOGICAL}, ! tag_opened = {"OPENED", " opened = %v", BT_LOGICAL}, ! tag_named = {"NAMED", " named = %v", BT_LOGICAL}, ! tag_name = {"NAME", " name = %v", BT_CHARACTER}, ! tag_number = {"NUMBER", " number = %v", BT_INTEGER}, ! tag_s_access = {"ACCESS", " access = %v", BT_CHARACTER}, ! tag_sequential = {"SEQUENTIAL", " sequential = %v", BT_CHARACTER}, ! tag_direct = {"DIRECT", " direct = %v", BT_CHARACTER}, ! tag_s_form = {"FORM", " form = %v", BT_CHARACTER}, ! tag_formatted = {"FORMATTED", " formatted = %v", BT_CHARACTER}, ! tag_unformatted = {"UNFORMATTED", " unformatted = %v", BT_CHARACTER}, ! tag_s_recl = {"RECL", " recl = %v", BT_INTEGER}, ! tag_nextrec = {"NEXTREC", " nextrec = %v", BT_INTEGER}, ! tag_s_blank = {"BLANK", " blank = %v", BT_CHARACTER}, ! tag_s_position = {"POSITION", " position = %v", BT_CHARACTER}, ! tag_s_action = {"ACTION", " action = %v", BT_CHARACTER}, ! tag_read = {"READ", " read = %v", BT_CHARACTER}, ! tag_write = {"WRITE", " write = %v", BT_CHARACTER}, ! tag_readwrite = {"READWRITE", " readwrite = %v", BT_CHARACTER}, ! tag_s_delim = {"DELIM", " delim = %v", BT_CHARACTER}, ! tag_s_pad = {"PAD", " pad = %v", BT_CHARACTER}, ! tag_iolength = {"IOLENGTH", " iolength = %v", BT_INTEGER}, ! tag_convert = {"CONVERT", " convert = %e", BT_CHARACTER}, ! tag_strm_out = {"POS", " pos = %v", BT_INTEGER}, ! tag_err = {"ERR", " err = %l", BT_UNKNOWN}, ! tag_end = {"END", " end = %l", BT_UNKNOWN}, ! tag_eor = {"EOR", " eor = %l", BT_UNKNOWN}; static gfc_dt *current_dt; --- 32,100 ---- typedef struct { ! const char *name, *spec, *value; bt type; } io_tag; static const io_tag ! tag_file = { "FILE", " file =", " %e", BT_CHARACTER }, ! tag_status = { "STATUS", " status =", " %e", BT_CHARACTER}, ! tag_e_access = {"ACCESS", " access =", " %e", BT_CHARACTER}, ! tag_e_form = {"FORM", " form =", " %e", BT_CHARACTER}, ! tag_e_recl = {"RECL", " recl =", " %e", BT_INTEGER}, ! tag_e_blank = {"BLANK", " blank =", " %e", BT_CHARACTER}, ! tag_e_position = {"POSITION", " position =", " %e", BT_CHARACTER}, ! tag_e_action = {"ACTION", " action =", " %e", BT_CHARACTER}, ! tag_e_delim = {"DELIM", " delim =", " %e", BT_CHARACTER}, ! tag_e_pad = {"PAD", " pad =", " %e", BT_CHARACTER}, ! tag_e_decimal = {"DECIMAL", " decimal =", " %e", BT_CHARACTER}, ! tag_e_encoding = {"ENCODING", " encoding =", " %e", BT_CHARACTER}, ! tag_e_async = {"ASYNCHRONOUS", " asynchronous =", " %e", BT_CHARACTER}, ! tag_e_round = {"ROUND", " round =", " %e", BT_CHARACTER}, ! tag_e_sign = {"SIGN", " sign =", " %e", BT_CHARACTER}, ! tag_unit = {"UNIT", " unit =", " %e", BT_INTEGER}, ! tag_advance = {"ADVANCE", " advance =", " %e", BT_CHARACTER}, ! tag_rec = {"REC", " rec =", " %e", BT_INTEGER}, ! tag_spos = {"POSITION", " pos =", " %e", BT_INTEGER}, ! tag_format = {"FORMAT", NULL, NULL, BT_CHARACTER}, ! tag_iomsg = {"IOMSG", " iomsg =", " %e", BT_CHARACTER}, ! tag_iostat = {"IOSTAT", " iostat =", " %v", BT_INTEGER}, ! tag_size = {"SIZE", " size =", " %v", BT_INTEGER}, ! tag_exist = {"EXIST", " exist =", " %v", BT_LOGICAL}, ! tag_opened = {"OPENED", " opened =", " %v", BT_LOGICAL}, ! tag_named = {"NAMED", " named =", " %v", BT_LOGICAL}, ! tag_name = {"NAME", " name =", " %v", BT_CHARACTER}, ! tag_number = {"NUMBER", " number =", " %v", BT_INTEGER}, ! tag_s_access = {"ACCESS", " access =", " %v", BT_CHARACTER}, ! tag_sequential = {"SEQUENTIAL", " sequential =", " %v", BT_CHARACTER}, ! tag_direct = {"DIRECT", " direct =", " %v", BT_CHARACTER}, ! tag_s_form = {"FORM", " form =", " %v", BT_CHARACTER}, ! tag_formatted = {"FORMATTED", " formatted =", " %v", BT_CHARACTER}, ! tag_unformatted = {"UNFORMATTED", " unformatted =", " %v", BT_CHARACTER}, ! tag_s_recl = {"RECL", " recl =", " %v", BT_INTEGER}, ! tag_nextrec = {"NEXTREC", " nextrec =", " %v", BT_INTEGER}, ! tag_s_blank = {"BLANK", " blank =", " %v", BT_CHARACTER}, ! tag_s_position = {"POSITION", " position =", " %v", BT_CHARACTER}, ! tag_s_action = {"ACTION", " action =", " %v", BT_CHARACTER}, ! tag_read = {"READ", " read =", " %v", BT_CHARACTER}, ! tag_write = {"WRITE", " write =", " %v", BT_CHARACTER}, ! tag_readwrite = {"READWRITE", " readwrite =", " %v", BT_CHARACTER}, ! tag_s_delim = {"DELIM", " delim =", " %v", BT_CHARACTER}, ! tag_s_pad = {"PAD", " pad =", " %v", BT_CHARACTER}, ! tag_s_decimal = {"DECIMAL", " decimal =", " %v", BT_CHARACTER}, ! tag_s_encoding = {"ENCODING", " encoding =", " %v", BT_CHARACTER}, ! tag_s_async = {"ASYNCHRONOUS", " asynchronous =", " %v", BT_CHARACTER}, ! tag_s_round = {"ROUND", " round =", " %v", BT_CHARACTER}, ! tag_s_sign = {"SIGN", " sign =", " %v", BT_CHARACTER}, ! tag_iolength = {"IOLENGTH", " iolength =", " %v", BT_INTEGER}, ! tag_convert = {"CONVERT", " convert =", " %e", BT_CHARACTER}, ! tag_strm_out = {"POS", " pos =", " %v", BT_INTEGER}, ! tag_err = {"ERR", " err =", " %l", BT_UNKNOWN}, ! tag_end = {"END", " end =", " %l", BT_UNKNOWN}, ! tag_eor = {"EOR", " eor =", " %l", BT_UNKNOWN}, ! tag_id = {"ID", " id =", " %v", BT_INTEGER}, ! tag_pending = {"PENDING", " pending =", " %v", BT_LOGICAL}; static gfc_dt *current_dt; *************** static gfc_dt *current_dt; *** 95,111 **** typedef enum { FMT_NONE, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD, ! FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_POS, FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_SIGN, FMT_BLANK, FMT_CHAR, FMT_P, FMT_IBOZ, FMT_F, ! FMT_E, FMT_EXT, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_ERROR } format_token; /* Local variables for checking format strings. The saved_token is used to back up by a single format token during the parsing process. */ ! static char *format_string; static int format_length, use_last_char; static format_token saved_token; --- 107,127 ---- typedef enum { FMT_NONE, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD, ! FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_SIGN, FMT_BLANK, FMT_CHAR, FMT_P, FMT_IBOZ, FMT_F, ! FMT_E, FMT_EXT, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_ERROR, FMT_DC, ! FMT_DP, FMT_T, FMT_TR, FMT_TL } format_token; /* Local variables for checking format strings. The saved_token is used to back up by a single format token during the parsing process. */ ! static gfc_char_t *format_string; ! static int format_string_pos; static int format_length, use_last_char; + static char error_element; + static locus format_locus; static format_token saved_token; *************** mode; *** 119,125 **** static char next_char (int in_string) { ! static char c; if (use_last_char) { --- 135,141 ---- static char next_char (int in_string) { ! static gfc_char_t c; if (use_last_char) { *************** next_char (int in_string) *** 140,157 **** if (gfc_option.flag_backslash && c == '\\') { - int tmp; locus old_locus = gfc_current_locus; ! /* Use a temp variable to avoid side effects from gfc_match_special_char ! since it uses an int * for its argument. */ ! tmp = (int)c; ! ! if (gfc_match_special_char (&tmp) == MATCH_NO) gfc_current_locus = old_locus; - c = (char)tmp; - if (!(gfc_option.allow_std & GFC_STD_GNU) && !inhibit_warnings) gfc_warning ("Extension: backslash character at %C"); } --- 156,166 ---- if (gfc_option.flag_backslash && c == '\\') { locus old_locus = gfc_current_locus; ! if (gfc_match_special_char (&c) == MATCH_NO) gfc_current_locus = old_locus; if (!(gfc_option.allow_std & GFC_STD_GNU) && !inhibit_warnings) gfc_warning ("Extension: backslash character at %C"); } *************** next_char (int in_string) *** 159,165 **** if (mode == MODE_COPY) *format_string++ = c; ! c = TOUPPER (c); return c; } --- 168,179 ---- if (mode == MODE_COPY) *format_string++ = c; ! if (mode != MODE_STRING) ! format_locus = gfc_current_locus; ! ! format_string_pos++; ! ! c = gfc_wide_toupper (c); return c; } *************** next_char_not_space (bool *error) *** 180,186 **** char c; do { ! c = next_char (0); if (c == '\t') { if (gfc_option.allow_std & GFC_STD_GNU) --- 194,200 ---- char c; do { ! error_element = c = next_char (0); if (c == '\t') { if (gfc_option.allow_std & GFC_STD_GNU) *************** format_lex (void) *** 303,312 **** case 'T': c = next_char_not_space (&error); ! if (c != 'L' && c != 'R') ! unget_char (); ! ! token = FMT_POS; break; case '(': --- 317,334 ---- case 'T': c = next_char_not_space (&error); ! switch (c) ! { ! case 'L': ! token = FMT_TL; ! break; ! case 'R': ! token = FMT_TR; ! break; ! default: ! token = FMT_T; ! unget_char (); ! } break; case '(': *************** format_lex (void) *** 420,426 **** break; case 'D': ! token = FMT_D; break; case '\0': --- 442,467 ---- break; case 'D': ! c = next_char_not_space (&error); ! if (c == 'P') ! { ! if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DP format " ! "specifier not allowed at %C") == FAILURE) ! return FMT_ERROR; ! token = FMT_DP; ! } ! else if (c == 'C') ! { ! if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DC format " ! "specifier not allowed at %C") == FAILURE) ! return FMT_ERROR; ! token = FMT_DC; ! } ! else ! { ! token = FMT_D; ! unget_char (); ! } break; case '\0': *************** format_lex (void) *** 444,468 **** by itself, and we are checking it for validity. The dual origin means that the warning message is a little less than great. */ ! static try check_format (bool is_input) { const char *posint_required = _("Positive width required"); const char *nonneg_required = _("Nonnegative width required"); ! const char *unexpected_element = _("Unexpected element"); const char *unexpected_end = _("Unexpected end of format string"); const char *error; format_token t, u; int level; int repeat; ! try rv; use_last_char = 0; saved_token = FMT_NONE; level = 0; repeat = 0; rv = SUCCESS; t = format_lex (); if (t == FMT_ERROR) --- 485,512 ---- by itself, and we are checking it for validity. The dual origin means that the warning message is a little less than great. */ ! static gfc_try check_format (bool is_input) { const char *posint_required = _("Positive width required"); const char *nonneg_required = _("Nonnegative width required"); ! const char *unexpected_element = _("Unexpected element '%c' in format string" ! " at %L"); const char *unexpected_end = _("Unexpected end of format string"); + const char *zero_width = _("Zero width in format descriptor"); const char *error; format_token t, u; int level; int repeat; ! gfc_try rv; use_last_char = 0; saved_token = FMT_NONE; level = 0; repeat = 0; rv = SUCCESS; + format_string_pos = 0; t = format_lex (); if (t == FMT_ERROR) *************** format_item_1: *** 537,542 **** --- 581,588 ---- case FMT_SIGN: case FMT_BLANK: + case FMT_DP: + case FMT_DC: goto between_desc; case FMT_CHAR: *************** format_item_1: *** 562,568 **** goto finished; ! case FMT_POS: case FMT_IBOZ: case FMT_F: case FMT_E: --- 608,616 ---- goto finished; ! case FMT_T: ! case FMT_TL: ! case FMT_TR: case FMT_IBOZ: case FMT_F: case FMT_E: *************** data_desc: *** 590,595 **** --- 638,645 ---- { case FMT_SIGN: case FMT_BLANK: + case FMT_DP: + case FMT_DC: case FMT_X: break; *************** data_desc: *** 610,616 **** goto optional_comma; ! case FMT_POS: case FMT_L: t = format_lex (); if (t == FMT_ERROR) --- 660,676 ---- goto optional_comma; ! case FMT_T: ! case FMT_TL: ! case FMT_TR: ! t = format_lex (); ! if (t != FMT_POSINT) ! { ! error = _("Positive width required with T descriptor"); ! goto syntax; ! } ! break; ! case FMT_L: t = format_lex (); if (t == FMT_ERROR) *************** data_desc: *** 643,648 **** --- 703,713 ---- t = format_lex (); if (t == FMT_ERROR) goto fail; + if (t == FMT_ZERO) + { + error = zero_width; + goto syntax; + } if (t != FMT_POSINT) saved_token = t; break; *************** data_desc: *** 652,663 **** case FMT_G: case FMT_EXT: u = format_lex (); ! if (u == FMT_ERROR) ! goto fail; ! if (u != FMT_POSINT) { ! error = posint_required; ! goto syntax; } u = format_lex (); --- 717,752 ---- case FMT_G: case FMT_EXT: u = format_lex (); ! if (t == FMT_G && u == FMT_ZERO) { ! if (is_input) ! { ! error = zero_width; ! goto syntax; ! } ! if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: 'G0' in " ! "format at %C") == FAILURE) ! return FAILURE; ! u = format_lex (); ! if (u != FMT_PERIOD) ! { ! saved_token = u; ! break; ! } ! u = format_lex (); ! if (u != FMT_POSINT) ! { ! error = posint_required; ! goto syntax; ! } ! u = format_lex (); ! if (u == FMT_E) ! { ! error = _("E specifier not allowed with g0 descriptor"); ! goto syntax; ! } ! saved_token = u; ! break; } u = format_lex (); *************** data_desc: *** 753,759 **** gfc_warning ("The H format specifier at %C is" " a Fortran 95 deleted feature"); ! if(mode == MODE_STRING) { format_string += value; format_length -= value; --- 842,848 ---- gfc_warning ("The H format specifier at %C is" " a Fortran 95 deleted feature"); ! if (mode == MODE_STRING) { format_string += value; format_length -= value; *************** extension_optional_comma: *** 902,911 **** goto format_item; syntax: ! gfc_error ("%s in format string at %C", error); fail: - /* TODO: More elaborate measures are needed to show where a problem - is within a format string that has been calculated. */ rv = FAILURE; finished: --- 991,1003 ---- goto format_item; syntax: ! if (mode != MODE_FORMAT) ! format_locus.nextc += format_string_pos; ! if (error == unexpected_element) ! gfc_error (error, error_element, &format_locus); ! else ! gfc_error ("%s in format string at %L", error, &format_locus); fail: rv = FAILURE; finished: *************** finished: *** 916,922 **** /* Given an expression node that is a constant string, see if it looks like a format string. */ ! static try check_format_string (gfc_expr *e, bool is_input) { if (!e || e->ts.type != BT_CHARACTER || e->expr_type != EXPR_CONSTANT) --- 1008,1014 ---- /* Given an expression node that is a constant string, see if it looks like a format string. */ ! static gfc_try check_format_string (gfc_expr *e, bool is_input) { if (!e || e->ts.type != BT_CHARACTER || e->expr_type != EXPR_CONSTANT) *************** check_format_string (gfc_expr *e, bool i *** 924,929 **** --- 1016,1027 ---- mode = MODE_STRING; format_string = e->value.character.string; + + /* More elaborate measures are needed to show where a problem is within a + format string that has been calculated, but that's probably not worth the + effort. */ + format_locus = e->where; + return check_format (is_input); } *************** gfc_match_format (void) *** 981,987 **** e->ts.type = BT_CHARACTER; e->ts.kind = gfc_default_character_kind; e->where = start; ! e->value.character.string = format_string = gfc_getmem (format_length + 1); e->value.character.length = format_length; gfc_statement_label->format = e; --- 1079,1086 ---- e->ts.type = BT_CHARACTER; e->ts.kind = gfc_default_character_kind; e->where = start; ! e->value.character.string = format_string ! = gfc_get_wide_string (format_length + 1); e->value.character.length = format_length; gfc_statement_label->format = e; *************** match_etag (const io_tag *tag, gfc_expr *** 1001,1010 **** gfc_expr *result; match m; ! m = gfc_match (tag->spec, &result); if (m != MATCH_YES) return m; if (*v != NULL) { gfc_error ("Duplicate %s specification at %C", tag->name); --- 1100,1116 ---- gfc_expr *result; match m; ! m = gfc_match (tag->spec); if (m != MATCH_YES) return m; + m = gfc_match (tag->value, &result); + if (m != MATCH_YES) + { + gfc_error ("Invalid value for %s specification at %C", tag->name); + return MATCH_ERROR; + } + if (*v != NULL) { gfc_error ("Duplicate %s specification at %C", tag->name); *************** match_vtag (const io_tag *tag, gfc_expr *** 1025,1034 **** gfc_expr *result; match m; ! m = gfc_match (tag->spec, &result); if (m != MATCH_YES) return m; if (*v != NULL) { gfc_error ("Duplicate %s specification at %C", tag->name); --- 1131,1147 ---- gfc_expr *result; match m; ! m = gfc_match (tag->spec); if (m != MATCH_YES) return m; + m = gfc_match (tag->value, &result); + if (m != MATCH_YES) + { + gfc_error ("Invalid value for %s specification at %C", tag->name); + return MATCH_ERROR; + } + if (*v != NULL) { gfc_error ("Duplicate %s specification at %C", tag->name); *************** match_vtag (const io_tag *tag, gfc_expr *** 1038,1051 **** if (result->symtree->n.sym->attr.intent == INTENT_IN) { ! gfc_error ("Variable tag cannot be INTENT(IN) at %C"); gfc_free_expr (result); return MATCH_ERROR; } if (gfc_pure (NULL) && gfc_impure_variable (result->symtree->n.sym)) { ! gfc_error ("Variable tag cannot be assigned in PURE procedure at %C"); gfc_free_expr (result); return MATCH_ERROR; } --- 1151,1165 ---- if (result->symtree->n.sym->attr.intent == INTENT_IN) { ! gfc_error ("Variable %s cannot be INTENT(IN) at %C", tag->name); gfc_free_expr (result); return MATCH_ERROR; } if (gfc_pure (NULL) && gfc_impure_variable (result->symtree->n.sym)) { ! gfc_error ("Variable %s cannot be assigned in PURE procedure at %C", ! tag->name); gfc_free_expr (result); return MATCH_ERROR; } *************** match_vtag (const io_tag *tag, gfc_expr *** 1058,1070 **** /* Match I/O tags that cause variables to become redefined. */ static match ! match_out_tag(const io_tag *tag, gfc_expr **result) { match m; ! m = match_vtag(tag, result); if (m == MATCH_YES) ! gfc_check_do_variable((*result)->symtree); return m; } --- 1172,1184 ---- /* Match I/O tags that cause variables to become redefined. */ static match ! match_out_tag (const io_tag *tag, gfc_expr **result) { match m; ! m = match_vtag (tag, result); if (m == MATCH_YES) ! gfc_check_do_variable ((*result)->symtree); return m; } *************** match_ltag (const io_tag *tag, gfc_st_la *** 1079,1093 **** gfc_st_label *old; old = *label; ! m = gfc_match (tag->spec, label); ! if (m == MATCH_YES && old != 0) { gfc_error ("Duplicate %s label specification at %C", tag->name); return MATCH_ERROR; } ! if (m == MATCH_YES ! && gfc_reference_st_label (*label, ST_LABEL_TARGET) == FAILURE) return MATCH_ERROR; return m; --- 1193,1216 ---- gfc_st_label *old; old = *label; ! m = gfc_match (tag->spec); ! if (m != MATCH_YES) ! return m; ! ! m = gfc_match (tag->value, label); ! if (m != MATCH_YES) ! { ! gfc_error ("Invalid value for %s specification at %C", tag->name); ! return MATCH_ERROR; ! } ! ! if (old) { gfc_error ("Duplicate %s label specification at %C", tag->name); return MATCH_ERROR; } ! if (gfc_reference_st_label (*label, ST_LABEL_TARGET) == FAILURE) return MATCH_ERROR; return m; *************** match_ltag (const io_tag *tag, gfc_st_la *** 1096,1102 **** /* Resolution of the FORMAT tag, to be called from resolve_tag. */ ! static try resolve_tag_format (const gfc_expr *e) { if (e->expr_type == EXPR_CONSTANT --- 1219,1225 ---- /* Resolution of the FORMAT tag, to be called from resolve_tag. */ ! static gfc_try resolve_tag_format (const gfc_expr *e) { if (e->expr_type == EXPR_CONSTANT *************** resolve_tag_format (const gfc_expr *e) *** 1165,1171 **** /* Do expression resolution and type-checking on an expression tag. */ ! static try resolve_tag (const io_tag *tag, gfc_expr *e) { if (e == NULL) --- 1288,1294 ---- /* Do expression resolution and type-checking on an expression tag. */ ! static gfc_try resolve_tag (const io_tag *tag, gfc_expr *e) { if (e == NULL) *************** match_open_element (gfc_open *open) *** 1224,1229 **** --- 1347,1355 ---- { match m; + m = match_etag (&tag_e_async, &open->asynchronous); + if (m != MATCH_NO) + return m; m = match_etag (&tag_unit, &open->unit); if (m != MATCH_NO) return m; *************** match_open_element (gfc_open *open) *** 1263,1268 **** --- 1389,1406 ---- m = match_etag (&tag_e_pad, &open->pad); if (m != MATCH_NO) return m; + m = match_etag (&tag_e_decimal, &open->decimal); + if (m != MATCH_NO) + return m; + m = match_etag (&tag_e_encoding, &open->encoding); + if (m != MATCH_NO) + return m; + m = match_etag (&tag_e_round, &open->round); + if (m != MATCH_NO) + return m; + m = match_etag (&tag_e_sign, &open->sign); + if (m != MATCH_NO) + return m; m = match_ltag (&tag_err, &open->err); if (m != MATCH_NO) return m; *************** gfc_free_open (gfc_open *open) *** 1295,1308 **** gfc_free_expr (open->action); gfc_free_expr (open->delim); gfc_free_expr (open->pad); gfc_free_expr (open->convert); gfc_free (open); } /* Resolve everything in a gfc_open structure. */ ! try gfc_resolve_open (gfc_open *open) { --- 1433,1451 ---- gfc_free_expr (open->action); gfc_free_expr (open->delim); gfc_free_expr (open->pad); + gfc_free_expr (open->decimal); + gfc_free_expr (open->encoding); + gfc_free_expr (open->round); + gfc_free_expr (open->sign); gfc_free_expr (open->convert); + gfc_free_expr (open->asynchronous); gfc_free (open); } /* Resolve everything in a gfc_open structure. */ ! gfc_try gfc_resolve_open (gfc_open *open) { *************** gfc_resolve_open (gfc_open *open) *** 1319,1324 **** --- 1462,1472 ---- RESOLVE_TAG (&tag_e_action, open->action); RESOLVE_TAG (&tag_e_delim, open->delim); RESOLVE_TAG (&tag_e_pad, open->pad); + RESOLVE_TAG (&tag_e_decimal, open->decimal); + RESOLVE_TAG (&tag_e_encoding, open->encoding); + RESOLVE_TAG (&tag_e_async, open->asynchronous); + RESOLVE_TAG (&tag_e_round, open->round); + RESOLVE_TAG (&tag_e_sign, open->sign); RESOLVE_TAG (&tag_convert, open->convert); if (gfc_reference_st_label (open->err, ST_LABEL_TARGET) == FAILURE) *************** gfc_resolve_open (gfc_open *open) *** 1335,1347 **** static int compare_to_allowed_values (const char *specifier, const char *allowed[], const char *allowed_f2003[], ! const char *allowed_gnu[], char *value, const char *statement, bool warn) { int i; unsigned int len; ! len = strlen (value); if (len > 0) { for (len--; len > 0; len--) --- 1483,1495 ---- static int compare_to_allowed_values (const char *specifier, const char *allowed[], const char *allowed_f2003[], ! const char *allowed_gnu[], gfc_char_t *value, const char *statement, bool warn) { int i; unsigned int len; ! len = gfc_wide_strlen (value); if (len > 0) { for (len--; len > 0; len--) *************** compare_to_allowed_values (const char *s *** 1352,1364 **** for (i = 0; allowed[i]; i++) if (len == strlen (allowed[i]) ! && strncasecmp (value, allowed[i], strlen (allowed[i])) == 0) return 1; for (i = 0; allowed_f2003 && allowed_f2003[i]; i++) if (len == strlen (allowed_f2003[i]) ! && strncasecmp (value, allowed_f2003[i], strlen (allowed_f2003[i])) ! == 0) { notification n = gfc_notification_std (GFC_STD_F2003); --- 1500,1512 ---- for (i = 0; allowed[i]; i++) if (len == strlen (allowed[i]) ! && gfc_wide_strncasecmp (value, allowed[i], strlen (allowed[i])) == 0) return 1; for (i = 0; allowed_f2003 && allowed_f2003[i]; i++) if (len == strlen (allowed_f2003[i]) ! && gfc_wide_strncasecmp (value, allowed_f2003[i], ! strlen (allowed_f2003[i])) == 0) { notification n = gfc_notification_std (GFC_STD_F2003); *************** compare_to_allowed_values (const char *s *** 1384,1390 **** for (i = 0; allowed_gnu && allowed_gnu[i]; i++) if (len == strlen (allowed_gnu[i]) ! && strncasecmp (value, allowed_gnu[i], strlen (allowed_gnu[i])) == 0) { notification n = gfc_notification_std (GFC_STD_GNU); --- 1532,1539 ---- for (i = 0; allowed_gnu && allowed_gnu[i]; i++) if (len == strlen (allowed_gnu[i]) ! && gfc_wide_strncasecmp (value, allowed_gnu[i], ! strlen (allowed_gnu[i])) == 0) { notification n = gfc_notification_std (GFC_STD_GNU); *************** compare_to_allowed_values (const char *s *** 1410,1423 **** if (warn) { gfc_warning ("%s specifier in %s statement at %C has invalid value '%s'", ! specifier, statement, value); return 1; } else { gfc_error ("%s specifier in %s statement at %C has invalid value '%s'", ! specifier, statement, value); return 0; } } --- 1559,1576 ---- if (warn) { + char *s = gfc_widechar_to_char (value, -1); gfc_warning ("%s specifier in %s statement at %C has invalid value '%s'", ! specifier, statement, s); ! gfc_free (s); return 1; } else { + char *s = gfc_widechar_to_char (value, -1); gfc_error ("%s specifier in %s statement at %C has invalid value '%s'", ! specifier, statement, s); ! gfc_free (s); return 0; } } *************** gfc_match_open (void) *** 1436,1442 **** if (m == MATCH_NO) return m; ! open = gfc_getmem (sizeof (gfc_open)); m = match_open_element (open); --- 1589,1595 ---- if (m == MATCH_NO) return m; ! open = XCNEW (gfc_open); m = match_open_element (open); *************** gfc_match_open (void) *** 1501,1563 **** } /* Checks on the ASYNCHRONOUS specifier. */ ! /* TODO: code is ready, just needs uncommenting when async I/O support ! is added ;-) ! if (open->asynchronous && open->asynchronous->expr_type == EXPR_CONSTANT) { ! static const char * asynchronous[] = { "YES", "NO", NULL }; ! ! if (!compare_to_allowed_values ! ("action", asynchronous, NULL, NULL, ! open->asynchronous->value.character.string, "OPEN", warn)) goto cleanup; ! }*/ ! /* Checks on the BLANK specifier. */ ! if (open->blank && open->blank->expr_type == EXPR_CONSTANT) { ! static const char *blank[] = { "ZERO", "NULL", NULL }; ! ! if (!compare_to_allowed_values ("BLANK", blank, NULL, NULL, ! open->blank->value.character.string, ! "OPEN", warn)) goto cleanup; } /* Checks on the DECIMAL specifier. */ ! /* TODO: uncomment this code when DECIMAL support is added ! if (open->decimal && open->decimal->expr_type == EXPR_CONSTANT) { ! static const char * decimal[] = { "COMMA", "POINT", NULL }; ! ! if (!compare_to_allowed_values ("DECIMAL", decimal, NULL, NULL, ! open->decimal->value.character.string, ! "OPEN", warn)) goto cleanup; ! } */ /* Checks on the DELIM specifier. */ ! if (open->delim && open->delim->expr_type == EXPR_CONSTANT) { ! static const char *delim[] = { "APOSTROPHE", "QUOTE", "NONE", NULL }; ! ! if (!compare_to_allowed_values ("DELIM", delim, NULL, NULL, ! open->delim->value.character.string, ! "OPEN", warn)) goto cleanup; } /* Checks on the ENCODING specifier. */ ! /* TODO: uncomment this code when ENCODING support is added ! if (open->encoding && open->encoding->expr_type == EXPR_CONSTANT) { ! static const char * encoding[] = { "UTF-8", "DEFAULT", NULL }; ! ! if (!compare_to_allowed_values ("ENCODING", encoding, NULL, NULL, ! open->encoding->value.character.string, ! "OPEN", warn)) goto cleanup; ! } */ /* Checks on the FORM specifier. */ if (open->form && open->form->expr_type == EXPR_CONSTANT) --- 1654,1747 ---- } /* Checks on the ASYNCHRONOUS specifier. */ ! if (open->asynchronous) { ! if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ASYNCHRONOUS= at %C " ! "not allowed in Fortran 95") == FAILURE) goto cleanup; ! ! if (open->asynchronous->expr_type == EXPR_CONSTANT) ! { ! static const char * asynchronous[] = { "YES", "NO", NULL }; ! ! if (!compare_to_allowed_values ("ASYNCHRONOUS", asynchronous, ! NULL, NULL, open->asynchronous->value.character.string, ! "OPEN", warn)) ! goto cleanup; ! } ! } ! /* Checks on the BLANK specifier. */ ! if (open->blank) { ! if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: BLANK= at %C " ! "not allowed in Fortran 95") == FAILURE) goto cleanup; + + if (open->blank->expr_type == EXPR_CONSTANT) + { + static const char *blank[] = { "ZERO", "NULL", NULL }; + + if (!compare_to_allowed_values ("BLANK", blank, NULL, NULL, + open->blank->value.character.string, + "OPEN", warn)) + goto cleanup; + } } /* Checks on the DECIMAL specifier. */ ! if (open->decimal) { ! if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DECIMAL= at %C " ! "not allowed in Fortran 95") == FAILURE) goto cleanup; ! ! if (open->decimal->expr_type == EXPR_CONSTANT) ! { ! static const char * decimal[] = { "COMMA", "POINT", NULL }; ! ! if (!compare_to_allowed_values ("DECIMAL", decimal, NULL, NULL, ! open->decimal->value.character.string, ! "OPEN", warn)) ! goto cleanup; ! } ! } /* Checks on the DELIM specifier. */ ! if (open->delim) { ! if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DELIM= at %C " ! "not allowed in Fortran 95") == FAILURE) goto cleanup; + + if (open->delim->expr_type == EXPR_CONSTANT) + { + static const char *delim[] = { "APOSTROPHE", "QUOTE", "NONE", NULL }; + + if (!compare_to_allowed_values ("DELIM", delim, NULL, NULL, + open->delim->value.character.string, + "OPEN", warn)) + goto cleanup; + } } /* Checks on the ENCODING specifier. */ ! if (open->encoding) { ! if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ENCODING= at %C " ! "not allowed in Fortran 95") == FAILURE) goto cleanup; ! ! if (open->encoding->expr_type == EXPR_CONSTANT) ! { ! static const char * encoding[] = { "DEFAULT", "UTF-8", NULL }; ! ! if (!compare_to_allowed_values ("ENCODING", encoding, NULL, NULL, ! open->encoding->value.character.string, ! "OPEN", warn)) ! goto cleanup; ! } ! } /* Checks on the FORM specifier. */ if (open->form && open->form->expr_type == EXPR_CONSTANT) *************** gfc_match_open (void) *** 1593,1622 **** } /* Checks on the ROUND specifier. */ ! /* TODO: uncomment this code when ROUND support is added ! if (open->round && open->round->expr_type == EXPR_CONSTANT) { ! static const char * round[] = { "UP", "DOWN", "ZERO", "NEAREST", ! "COMPATIBLE", "PROCESSOR_DEFINED", NULL }; ! if (!compare_to_allowed_values ("ROUND", round, NULL, NULL, ! open->round->value.character.string, ! "OPEN", warn)) ! goto cleanup; ! } */ /* Checks on the SIGN specifier. */ ! /* TODO: uncomment this code when SIGN support is added ! if (open->sign && open->sign->expr_type == EXPR_CONSTANT) { ! static const char * sign[] = { "PLUS", "SUPPRESS", "PROCESSOR_DEFINED", ! NULL }; ! ! if (!compare_to_allowed_values ("SIGN", sign, NULL, NULL, ! open->sign->value.character.string, ! "OPEN", warn)) goto cleanup; ! } */ #define warn_or_error(...) \ { \ --- 1777,1819 ---- } /* Checks on the ROUND specifier. */ ! if (open->round) { ! /* When implemented, change the following to use gfc_notify_std F2003. */ ! gfc_error ("Fortran F2003: ROUND= specifier at %C not implemented"); ! goto cleanup; ! if (open->round->expr_type == EXPR_CONSTANT) ! { ! static const char * round[] = { "UP", "DOWN", "ZERO", "NEAREST", ! "COMPATIBLE", "PROCESSOR_DEFINED", ! NULL }; ! ! if (!compare_to_allowed_values ("ROUND", round, NULL, NULL, ! open->round->value.character.string, ! "OPEN", warn)) ! goto cleanup; ! } ! } /* Checks on the SIGN specifier. */ ! if (open->sign) { ! if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: SIGN= at %C " ! "not allowed in Fortran 95") == FAILURE) goto cleanup; ! ! if (open->sign->expr_type == EXPR_CONSTANT) ! { ! static const char * sign[] = { "PLUS", "SUPPRESS", "PROCESSOR_DEFINED", ! NULL }; ! ! if (!compare_to_allowed_values ("SIGN", sign, NULL, NULL, ! open->sign->value.character.string, ! "OPEN", warn)) ! goto cleanup; ! } ! } #define warn_or_error(...) \ { \ *************** gfc_match_open (void) *** 1651,1670 **** /* F2003, 9.4.5: If the STATUS= specifier has the value NEW or REPLACE, the FILE= specifier shall appear. */ if (open->file == NULL ! && (strncasecmp (open->status->value.character.string, "replace", 7) ! == 0 ! || strncasecmp (open->status->value.character.string, "new", 3) ! == 0)) { warn_or_error ("The STATUS specified in OPEN statement at %C is " ! "'%s' and no FILE specifier is present", ! open->status->value.character.string); } /* F2003, 9.4.5: If the STATUS= specifier has the value SCRATCH, the FILE= specifier shall not appear. */ ! if (strncasecmp (open->status->value.character.string, "scratch", 7) ! == 0 && open->file) { warn_or_error ("The STATUS specified in OPEN statement at %C " "cannot have the value SCRATCH if a FILE specifier " --- 1848,1869 ---- /* F2003, 9.4.5: If the STATUS= specifier has the value NEW or REPLACE, the FILE= specifier shall appear. */ if (open->file == NULL ! && (gfc_wide_strncasecmp (open->status->value.character.string, ! "replace", 7) == 0 ! || gfc_wide_strncasecmp (open->status->value.character.string, ! "new", 3) == 0)) { + char *s = gfc_widechar_to_char (open->status->value.character.string, + -1); warn_or_error ("The STATUS specified in OPEN statement at %C is " ! "'%s' and no FILE specifier is present", s); ! gfc_free (s); } /* F2003, 9.4.5: If the STATUS= specifier has the value SCRATCH, the FILE= specifier shall not appear. */ ! if (gfc_wide_strncasecmp (open->status->value.character.string, ! "scratch", 7) == 0 && open->file) { warn_or_error ("The STATUS specified in OPEN statement at %C " "cannot have the value SCRATCH if a FILE specifier " *************** gfc_match_open (void) *** 1674,1686 **** /* Things that are not allowed for unformatted I/O. */ if (open->form && open->form->expr_type == EXPR_CONSTANT ! && (open->delim ! /* TODO uncomment this code when F2003 support is finished */ ! /* || open->decimal || open->encoding || open->round ! || open->sign */ ! || open->pad || open->blank) ! && strncasecmp (open->form->value.character.string, ! "unformatted", 11) == 0) { const char *spec = (open->delim ? "DELIM " : (open->pad ? "PAD " : open->blank --- 1873,1882 ---- /* Things that are not allowed for unformatted I/O. */ if (open->form && open->form->expr_type == EXPR_CONSTANT ! && (open->delim || open->decimal || open->encoding || open->round ! || open->sign || open->pad || open->blank) ! && gfc_wide_strncasecmp (open->form->value.character.string, ! "unformatted", 11) == 0) { const char *spec = (open->delim ? "DELIM " : (open->pad ? "PAD " : open->blank *************** gfc_match_open (void) *** 1691,1697 **** } if (open->recl && open->access && open->access->expr_type == EXPR_CONSTANT ! && strncasecmp (open->access->value.character.string, "stream", 6) == 0) { warn_or_error ("RECL specifier not allowed in OPEN statement at %C for " "stream I/O"); --- 1887,1894 ---- } if (open->recl && open->access && open->access->expr_type == EXPR_CONSTANT ! && gfc_wide_strncasecmp (open->access->value.character.string, ! "stream", 6) == 0) { warn_or_error ("RECL specifier not allowed in OPEN statement at %C for " "stream I/O"); *************** gfc_match_open (void) *** 1699,1710 **** if (open->position && open->access && open->access->expr_type == EXPR_CONSTANT ! && !(strncasecmp (open->access->value.character.string, ! "sequential", 10) == 0 ! || strncasecmp (open->access->value.character.string, ! "stream", 6) == 0 ! || strncasecmp (open->access->value.character.string, ! "append", 6) == 0)) { warn_or_error ("POSITION specifier in OPEN statement at %C only allowed " "for stream or sequential ACCESS"); --- 1896,1907 ---- if (open->position && open->access && open->access->expr_type == EXPR_CONSTANT ! && !(gfc_wide_strncasecmp (open->access->value.character.string, ! "sequential", 10) == 0 ! || gfc_wide_strncasecmp (open->access->value.character.string, ! "stream", 6) == 0 ! || gfc_wide_strncasecmp (open->access->value.character.string, ! "append", 6) == 0)) { warn_or_error ("POSITION specifier in OPEN statement at %C only allowed " "for stream or sequential ACCESS"); *************** gfc_match_close (void) *** 1781,1787 **** if (m == MATCH_NO) return m; ! close = gfc_getmem (sizeof (gfc_close)); m = match_close_element (close); --- 1978,1984 ---- if (m == MATCH_NO) return m; ! close = XCNEW (gfc_close); m = match_close_element (close); *************** cleanup: *** 1847,1853 **** /* Resolve everything in a gfc_close structure. */ ! try gfc_resolve_close (gfc_close *close) { RESOLVE_TAG (&tag_unit, close->unit); --- 2044,2050 ---- /* Resolve everything in a gfc_close structure. */ ! gfc_try gfc_resolve_close (gfc_close *close) { RESOLVE_TAG (&tag_unit, close->unit); *************** match_filepos (gfc_statement st, gfc_exe *** 1907,1913 **** gfc_filepos *fp; match m; ! fp = gfc_getmem (sizeof (gfc_filepos)); if (gfc_match_char ('(') == MATCH_NO) { --- 2104,2110 ---- gfc_filepos *fp; match m; ! fp = XCNEW (gfc_filepos); if (gfc_match_char ('(') == MATCH_NO) { *************** cleanup: *** 1971,1977 **** } ! try gfc_resolve_filepos (gfc_filepos *fp) { RESOLVE_TAG (&tag_unit, fp->unit); --- 2168,2174 ---- } ! gfc_try gfc_resolve_filepos (gfc_filepos *fp) { RESOLVE_TAG (&tag_unit, fp->unit); *************** gfc_match_flush (void) *** 2017,2027 **** /******************** Data Transfer Statements *********************/ - typedef enum - { M_READ, M_WRITE, M_PRINT, M_INQUIRE } - io_kind; - - /* Return a default unit number. */ static gfc_expr * --- 2214,2219 ---- *************** match_dt_element (io_kind k, gfc_dt *dt) *** 2203,2212 **** return MATCH_YES; } m = match_etag (&tag_rec, &dt->rec); if (m != MATCH_NO) return m; ! m = match_etag (&tag_spos, &dt->rec); if (m != MATCH_NO) return m; m = match_out_tag (&tag_iomsg, &dt->iomsg); --- 2395,2428 ---- return MATCH_YES; } + m = match_etag (&tag_e_async, &dt->asynchronous); + if (m != MATCH_NO) + return m; + m = match_etag (&tag_e_blank, &dt->blank); + if (m != MATCH_NO) + return m; + m = match_etag (&tag_e_delim, &dt->delim); + if (m != MATCH_NO) + return m; + m = match_etag (&tag_e_pad, &dt->pad); + if (m != MATCH_NO) + return m; + m = match_etag (&tag_e_sign, &dt->sign); + if (m != MATCH_NO) + return m; + m = match_etag (&tag_e_round, &dt->round); + if (m != MATCH_NO) + return m; + m = match_out_tag (&tag_id, &dt->id); + if (m != MATCH_NO) + return m; + m = match_etag (&tag_e_decimal, &dt->decimal); + if (m != MATCH_NO) + return m; m = match_etag (&tag_rec, &dt->rec); if (m != MATCH_NO) return m; ! m = match_etag (&tag_spos, &dt->pos); if (m != MATCH_NO) return m; m = match_out_tag (&tag_iomsg, &dt->iomsg); *************** gfc_free_dt (gfc_dt *dt) *** 2265,2297 **** gfc_free_expr (dt->iomsg); gfc_free_expr (dt->iostat); gfc_free_expr (dt->size); gfc_free (dt); } /* Resolve everything in a gfc_dt structure. */ ! try gfc_resolve_dt (gfc_dt *dt) { gfc_expr *e; RESOLVE_TAG (&tag_format, dt->format_expr); RESOLVE_TAG (&tag_rec, dt->rec); ! RESOLVE_TAG (&tag_spos, dt->rec); RESOLVE_TAG (&tag_advance, dt->advance); RESOLVE_TAG (&tag_iomsg, dt->iomsg); RESOLVE_TAG (&tag_iostat, dt->iostat); RESOLVE_TAG (&tag_size, dt->size); e = dt->io_unit; if (gfc_resolve_expr (e) == SUCCESS && (e->ts.type != BT_INTEGER && (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_VARIABLE))) { ! gfc_error ("UNIT specification at %L must be an INTEGER expression " ! "or a CHARACTER variable", &e->where); ! return FAILURE; } if (e->ts.type == BT_CHARACTER) --- 2481,2560 ---- gfc_free_expr (dt->iomsg); gfc_free_expr (dt->iostat); gfc_free_expr (dt->size); + gfc_free_expr (dt->pad); + gfc_free_expr (dt->delim); + gfc_free_expr (dt->sign); + gfc_free_expr (dt->round); + gfc_free_expr (dt->blank); + gfc_free_expr (dt->decimal); + gfc_free_expr (dt->extra_comma); + gfc_free_expr (dt->pos); gfc_free (dt); } /* Resolve everything in a gfc_dt structure. */ ! gfc_try gfc_resolve_dt (gfc_dt *dt) { gfc_expr *e; RESOLVE_TAG (&tag_format, dt->format_expr); RESOLVE_TAG (&tag_rec, dt->rec); ! RESOLVE_TAG (&tag_spos, dt->pos); RESOLVE_TAG (&tag_advance, dt->advance); + RESOLVE_TAG (&tag_id, dt->id); RESOLVE_TAG (&tag_iomsg, dt->iomsg); RESOLVE_TAG (&tag_iostat, dt->iostat); RESOLVE_TAG (&tag_size, dt->size); + RESOLVE_TAG (&tag_e_pad, dt->pad); + RESOLVE_TAG (&tag_e_delim, dt->delim); + RESOLVE_TAG (&tag_e_sign, dt->sign); + RESOLVE_TAG (&tag_e_round, dt->round); + RESOLVE_TAG (&tag_e_blank, dt->blank); + RESOLVE_TAG (&tag_e_decimal, dt->decimal); + RESOLVE_TAG (&tag_e_async, dt->asynchronous); e = dt->io_unit; if (gfc_resolve_expr (e) == SUCCESS && (e->ts.type != BT_INTEGER && (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_VARIABLE))) { ! /* If there is no extra comma signifying the "format" form of the IO ! statement, then this must be an error. */ ! if (!dt->extra_comma) ! { ! gfc_error ("UNIT specification at %L must be an INTEGER expression " ! "or a CHARACTER variable", &e->where); ! return FAILURE; ! } ! else ! { ! /* At this point, we have an extra comma. If io_unit has arrived as ! type character, we assume its really the "format" form of the I/O ! statement. We set the io_unit to the default unit and format to ! the character expression. See F95 Standard section 9.4. */ ! io_kind k; ! k = dt->extra_comma->value.iokind; ! if (e->ts.type == BT_CHARACTER && (k == M_READ || k == M_PRINT)) ! { ! dt->format_expr = dt->io_unit; ! dt->io_unit = default_unit (k); ! ! /* Free this pointer now so that a warning/error is not triggered ! below for the "Extension". */ ! gfc_free_expr (dt->extra_comma); ! dt->extra_comma = NULL; ! } ! ! if (k == M_WRITE) ! { ! gfc_error ("Invalid form of WRITE statement at %L, UNIT required", ! &dt->extra_comma->where); ! return FAILURE; ! } ! } } if (e->ts.type == BT_CHARACTER) *************** gfc_resolve_dt (gfc_dt *dt) *** 2309,2314 **** --- 2572,2582 ---- return FAILURE; } + if (dt->extra_comma + && gfc_notify_std (GFC_STD_GNU, "Extension: Comma before i/o " + "item list at %L", &dt->extra_comma->where) == FAILURE) + return FAILURE; + if (dt->err) { if (gfc_reference_st_label (dt->err, ST_LABEL_TARGET) == FAILURE) *************** static match match_io_element (io_kind, *** 2398,2404 **** static match match_io_iterator (io_kind k, gfc_code **result) { ! gfc_code *head, *tail, *new; gfc_iterator *iter; locus old_loc; match m; --- 2666,2672 ---- static match match_io_iterator (io_kind k, gfc_code **result) { ! gfc_code *head, *tail, *new_code; gfc_iterator *iter; locus old_loc; match m; *************** match_io_iterator (io_kind k, gfc_code * *** 2434,2440 **** break; } ! m = match_io_element (k, &new); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) --- 2702,2708 ---- break; } ! m = match_io_element (k, &new_code); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) *************** match_io_iterator (io_kind k, gfc_code * *** 2444,2450 **** goto cleanup; } ! tail = gfc_append_code (tail, new); if (gfc_match_char (',') != MATCH_YES) { --- 2712,2718 ---- goto cleanup; } ! tail = gfc_append_code (tail, new_code); if (gfc_match_char (',') != MATCH_YES) { *************** match_io_iterator (io_kind k, gfc_code * *** 2458,2472 **** if (gfc_match_char (')') != MATCH_YES) goto syntax; ! new = gfc_get_code (); ! new->op = EXEC_DO; ! new->ext.iterator = iter; ! new->block = gfc_get_code (); ! new->block->op = EXEC_DO; ! new->block->next = head; ! *result = new; return MATCH_YES; syntax: --- 2726,2740 ---- if (gfc_match_char (')') != MATCH_YES) goto syntax; ! new_code = gfc_get_code (); ! new_code->op = EXEC_DO; ! new_code->ext.iterator = iter; ! new_code->block = gfc_get_code (); ! new_code->block->op = EXEC_DO; ! new_code->block->next = head; ! *result = new_code; return MATCH_YES; syntax: *************** match_io_element (io_kind k, gfc_code ** *** 2574,2580 **** static match match_io_list (io_kind k, gfc_code **head_p) { ! gfc_code *head, *tail, *new; match m; *head_p = head = tail = NULL; --- 2842,2848 ---- static match match_io_list (io_kind k, gfc_code **head_p) { ! gfc_code *head, *tail, *new_code; match m; *head_p = head = tail = NULL; *************** match_io_list (io_kind k, gfc_code **hea *** 2583,2597 **** for (;;) { ! m = match_io_element (k, &new); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) goto syntax; ! tail = gfc_append_code (tail, new); if (head == NULL) ! head = new; if (gfc_match_eos () == MATCH_YES) break; --- 2851,2865 ---- for (;;) { ! m = match_io_element (k, &new_code); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) goto syntax; ! tail = gfc_append_code (tail, new_code); if (head == NULL) ! head = new_code; if (gfc_match_eos () == MATCH_YES) break; *************** if (condition) \ *** 2648,2653 **** --- 2916,2926 ---- match m; gfc_expr *expr; gfc_symbol *sym = NULL; + bool warn, unformatted; + + warn = (dt->err || dt->iostat) ? true : false; + unformatted = dt->format_expr == NULL && dt->format_label == NULL + && dt->namelist == NULL; m = MATCH_YES; *************** if (condition) \ *** 2668,2679 **** io_constraint (dt->rec != NULL, "REC tag at %L is incompatible with internal file", &dt->rec->where); ! io_constraint (dt->format_expr == NULL && dt->format_label == NULL ! && dt->namelist == NULL, "Unformatted I/O not allowed with internal unit at %L", &dt->io_unit->where); if (dt->namelist != NULL) { if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Internal file " --- 2941,2959 ---- io_constraint (dt->rec != NULL, "REC tag at %L is incompatible with internal file", &dt->rec->where); + + io_constraint (dt->pos != NULL, + "POS tag at %L is incompatible with internal file", + &dt->pos->where); ! io_constraint (unformatted, "Unformatted I/O not allowed with internal unit at %L", &dt->io_unit->where); + io_constraint (dt->asynchronous != NULL, + "ASYNCHRONOUS tag at %L not allowed with internal file", + &dt->asynchronous->where); + if (dt->namelist != NULL) { if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Internal file " *************** if (condition) \ *** 2696,2702 **** io_kind_name (k)); } - if (k != M_READ) { io_constraint (dt->end, "END tag not allowed with output at %L", --- 2976,2981 ---- *************** if (condition) \ *** 2705,2712 **** io_constraint (dt->eor, "EOR tag not allowed with output at %L", &dt->eor_where); ! io_constraint (k != M_READ && dt->size, ! "SIZE=specifier not allowed with output at %L", &dt->size->where); } else --- 2984,2996 ---- io_constraint (dt->eor, "EOR tag not allowed with output at %L", &dt->eor_where); ! io_constraint (dt->blank, "BLANK= specifier not allowed with output at %L", ! &dt->blank->where); ! ! io_constraint (dt->pad, "PAD= specifier not allowed with output at %L", ! &dt->pad->where); ! ! io_constraint (dt->size, "SIZE= specifier not allowed with output at %L", &dt->size->where); } else *************** if (condition) \ *** 2720,2727 **** --- 3004,3180 ---- &dt->eor_where); } + if (dt->asynchronous) + { + static const char * asynchronous[] = { "YES", "NO", NULL }; + + if (gfc_reduce_init_expr (dt->asynchronous) != SUCCESS) + { + gfc_error ("ASYNCHRONOUS= specifier at %L must be an initialization " + "expression", &dt->asynchronous->where); + return MATCH_ERROR; + } + + if (!compare_to_allowed_values + ("ASYNCHRONOUS", asynchronous, NULL, NULL, + dt->asynchronous->value.character.string, + io_kind_name (k), warn)) + return MATCH_ERROR; + } + + if (dt->id) + { + bool not_yes + = !dt->asynchronous + || gfc_wide_strlen (dt->asynchronous->value.character.string) != 3 + || gfc_wide_strncasecmp (dt->asynchronous->value.character.string, + "yes", 3) != 0; + io_constraint (not_yes, + "ID= specifier at %L must be with ASYNCHRONOUS='yes' " + "specifier", &dt->id->where); + } + if (dt->decimal) + { + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DECIMAL= at %C " + "not allowed in Fortran 95") == FAILURE) + return MATCH_ERROR; + + if (dt->decimal->expr_type == EXPR_CONSTANT) + { + static const char * decimal[] = { "COMMA", "POINT", NULL }; + if (!compare_to_allowed_values ("DECIMAL", decimal, NULL, NULL, + dt->decimal->value.character.string, + io_kind_name (k), warn)) + return MATCH_ERROR; + + io_constraint (unformatted, + "the DECIMAL= specifier at %L must be with an " + "explicit format expression", &dt->decimal->where); + } + } + + if (dt->blank) + { + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: BLANK= at %C " + "not allowed in Fortran 95") == FAILURE) + return MATCH_ERROR; + + if (dt->blank->expr_type == EXPR_CONSTANT) + { + static const char * blank[] = { "NULL", "ZERO", NULL }; + + if (!compare_to_allowed_values ("BLANK", blank, NULL, NULL, + dt->blank->value.character.string, + io_kind_name (k), warn)) + return MATCH_ERROR; + + io_constraint (unformatted, + "the BLANK= specifier at %L must be with an " + "explicit format expression", &dt->blank->where); + } + } + + if (dt->pad) + { + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PAD= at %C " + "not allowed in Fortran 95") == FAILURE) + return MATCH_ERROR; + + if (dt->pad->expr_type == EXPR_CONSTANT) + { + static const char * pad[] = { "YES", "NO", NULL }; + + if (!compare_to_allowed_values ("PAD", pad, NULL, NULL, + dt->pad->value.character.string, + io_kind_name (k), warn)) + return MATCH_ERROR; + + io_constraint (unformatted, + "the PAD= specifier at %L must be with an " + "explicit format expression", &dt->pad->where); + } + } + + if (dt->round) + { + /* When implemented, change the following to use gfc_notify_std F2003. + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ROUND= at %C " + "not allowed in Fortran 95") == FAILURE) + return MATCH_ERROR; */ + gfc_error ("F2003 Feature: ROUND= specifier at %C not implemented"); + return MATCH_ERROR; + + if (dt->round->expr_type == EXPR_CONSTANT) + { + static const char * round[] = { "UP", "DOWN", "ZERO", "NEAREST", + "COMPATIBLE", "PROCESSOR_DEFINED", + NULL }; + + if (!compare_to_allowed_values ("ROUND", round, NULL, NULL, + dt->round->value.character.string, + io_kind_name (k), warn)) + return MATCH_ERROR; + } + } + + if (dt->sign) + { + /* When implemented, change the following to use gfc_notify_std F2003. + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: SIGN= at %C " + "not allowed in Fortran 95") == FAILURE) + return MATCH_ERROR; */ + if (dt->sign->expr_type == EXPR_CONSTANT) + { + static const char * sign[] = { "PLUS", "SUPPRESS", "PROCESSOR_DEFINED", + NULL }; + + if (!compare_to_allowed_values ("SIGN", sign, NULL, NULL, + dt->sign->value.character.string, + io_kind_name (k), warn)) + return MATCH_ERROR; + + io_constraint (unformatted, + "SIGN= specifier at %L must be with an " + "explicit format expression", &dt->sign->where); + + io_constraint (k == M_READ, + "SIGN= specifier at %L not allowed in a " + "READ statement", &dt->sign->where); + } + } + + if (dt->delim) + { + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DELIM= at %C " + "not allowed in Fortran 95") == FAILURE) + return MATCH_ERROR; + + if (dt->delim->expr_type == EXPR_CONSTANT) + { + static const char *delim[] = { "APOSTROPHE", "QUOTE", "NONE", NULL }; + + if (!compare_to_allowed_values ("DELIM", delim, NULL, NULL, + dt->delim->value.character.string, + io_kind_name (k), warn)) + return MATCH_ERROR; + + io_constraint (k == M_READ, + "DELIM= specifier at %L not allowed in a " + "READ statement", &dt->delim->where); + + io_constraint (dt->format_label != &format_asterisk + && dt->namelist == NULL, + "DELIM= specifier at %L must have FMT=*", + &dt->delim->where); + + io_constraint (unformatted && dt->namelist == NULL, + "DELIM= specifier at %L must be with FMT=* or " + "NML= specifier ", &dt->delim->where); + } + } + if (dt->namelist) { io_constraint (io_code && dt->namelist, *************** if (condition) \ *** 2730,2736 **** io_constraint (dt->format_expr, "IO spec-list cannot contain both NAMELIST group name " ! "and format specification at %L.", &dt->format_expr->where); io_constraint (dt->format_label, --- 3183,3189 ---- io_constraint (dt->format_expr, "IO spec-list cannot contain both NAMELIST group name " ! "and format specification at %L", &dt->format_expr->where); io_constraint (dt->format_label, *************** if (condition) \ *** 2738,2761 **** "and format label at %L", spec_end); io_constraint (dt->rec, ! "NAMELIST IO is not allowed with a REC=specifier " ! "at %L.", &dt->rec->where); io_constraint (dt->advance, ! "NAMELIST IO is not allowed with a ADVANCE=specifier " ! "at %L.", &dt->advance->where); } if (dt->rec) { io_constraint (dt->end, "An END tag is not allowed with a " ! "REC=specifier at %L.", &dt->end_where); ! io_constraint (dt->format_label == &format_asterisk, ! "FMT=* is not allowed with a REC=specifier " ! "at %L.", spec_end); } if (dt->advance) --- 3191,3217 ---- "and format label at %L", spec_end); io_constraint (dt->rec, ! "NAMELIST IO is not allowed with a REC= specifier " ! "at %L", &dt->rec->where); io_constraint (dt->advance, ! "NAMELIST IO is not allowed with a ADVANCE= specifier " ! "at %L", &dt->advance->where); } if (dt->rec) { io_constraint (dt->end, "An END tag is not allowed with a " ! "REC= specifier at %L", &dt->end_where); io_constraint (dt->format_label == &format_asterisk, ! "FMT=* is not allowed with a REC= specifier " ! "at %L", spec_end); ! ! io_constraint (dt->pos, ! "POS= is not allowed with REC= specifier " ! "at %L", &dt->pos->where); } if (dt->advance) *************** if (condition) \ *** 2765,2782 **** io_constraint (dt->format_label == &format_asterisk, "List directed format(*) is not allowed with a " ! "ADVANCE=specifier at %L.", &expr->where); ! io_constraint (dt->format_expr == NULL && dt->format_label == NULL ! && dt->namelist == NULL, ! "the ADVANCE=specifier at %L must appear with an " "explicit format expression", &expr->where); if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_CHARACTER) { ! const char * advance = expr->value.character.string; ! not_no = strcasecmp (advance, "no") != 0; ! not_yes = strcasecmp (advance, "yes") != 0; } else { --- 3221,3239 ---- io_constraint (dt->format_label == &format_asterisk, "List directed format(*) is not allowed with a " ! "ADVANCE= specifier at %L.", &expr->where); ! io_constraint (unformatted, ! "the ADVANCE= specifier at %L must appear with an " "explicit format expression", &expr->where); if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_CHARACTER) { ! const gfc_char_t *advance = expr->value.character.string; ! not_no = gfc_wide_strlen (advance) != 2 ! || gfc_wide_strncasecmp (advance, "no", 2) != 0; ! not_yes = gfc_wide_strlen (advance) != 3 ! || gfc_wide_strncasecmp (advance, "yes", 3) != 0; } else { *************** if (condition) \ *** 2785,2791 **** } io_constraint (not_no && not_yes, ! "ADVANCE=specifier at %L must have value = " "YES or NO.", &expr->where); io_constraint (dt->size && not_no && k == M_READ, --- 3242,3248 ---- } io_constraint (not_no && not_yes, ! "ADVANCE= specifier at %L must have value = " "YES or NO.", &expr->where); io_constraint (dt->size && not_no && k == M_READ, *************** match_io (io_kind k) *** 2815,2821 **** char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_code *io_code; gfc_symbol *sym; ! int comma_flag, c; locus where; locus spec_end; gfc_dt *dt; --- 3272,3278 ---- char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_code *io_code; gfc_symbol *sym; ! int comma_flag; locus where; locus spec_end; gfc_dt *dt; *************** match_io (io_kind k) *** 2823,2829 **** where = gfc_current_locus; comma_flag = 0; ! current_dt = dt = gfc_getmem (sizeof (gfc_dt)); m = gfc_match_char ('('); if (m == MATCH_NO) { --- 3280,3286 ---- where = gfc_current_locus; comma_flag = 0; ! current_dt = dt = XCNEW (gfc_dt); m = gfc_match_char ('('); if (m == MATCH_NO) { *************** match_io (io_kind k) *** 2833,2839 **** else if (k == M_PRINT) { /* Treat the non-standard case of PRINT namelist. */ ! if ((gfc_current_form == FORM_FIXED || gfc_peek_char () == ' ') && gfc_match_name (name) == MATCH_YES) { gfc_find_symbol (name, NULL, 1, &sym); --- 3290,3296 ---- else if (k == M_PRINT) { /* Treat the non-standard case of PRINT namelist. */ ! if ((gfc_current_form == FORM_FIXED || gfc_peek_ascii_char () == ' ') && gfc_match_name (name) == MATCH_YES) { gfc_find_symbol (name, NULL, 1, &sym); *************** match_io (io_kind k) *** 2857,2863 **** if (gfc_current_form == FORM_FREE) { ! c = gfc_peek_char(); if (c != ' ' && c != '*' && c != '\'' && c != '"') { m = MATCH_NO; --- 3314,3320 ---- if (gfc_current_form == FORM_FREE) { ! char c = gfc_peek_ascii_char (); if (c != ' ' && c != '*' && c != '\'' && c != '"') { m = MATCH_NO; *************** get_io_list: *** 2968,2979 **** /* Used in check_io_constraints, where no locus is available. */ spec_end = gfc_current_locus; ! /* Optional leading comma (non-standard). */ ! if (!comma_flag ! && gfc_match_char (',') == MATCH_YES ! && gfc_notify_std (GFC_STD_GNU, "Extension: Comma before i/o " ! "item list at %C") == FAILURE) ! return MATCH_ERROR; io_code = NULL; if (gfc_match_eos () != MATCH_YES) --- 3425,3447 ---- /* Used in check_io_constraints, where no locus is available. */ spec_end = gfc_current_locus; ! /* Optional leading comma (non-standard). We use a gfc_expr structure here ! to save the locus. This is used later when resolving transfer statements ! that might have a format expression without unit number. */ ! if (!comma_flag && gfc_match_char (',') == MATCH_YES) ! { ! dt->extra_comma = gfc_get_expr (); ! ! /* Set the types to something compatible with iokind. This is needed to ! get through gfc_free_expr later since iokind really has no Basic Type, ! BT, of its own. */ ! dt->extra_comma->expr_type = EXPR_CONSTANT; ! dt->extra_comma->ts.type = BT_LOGICAL; ! ! /* Save the iokind and locus for later use in resolution. */ ! dt->extra_comma->value.iokind = k; ! dt->extra_comma->where = gfc_current_locus; ! } io_code = NULL; if (gfc_match_eos () != MATCH_YES) *************** gfc_match_read (void) *** 3025,3036 **** --- 3493,3506 ---- return match_io (M_READ); } + match gfc_match_write (void) { return match_io (M_WRITE); } + match gfc_match_print (void) { *************** gfc_free_inquire (gfc_inquire *inquire) *** 3083,3092 **** --- 3553,3570 ---- gfc_free_expr (inquire->write); gfc_free_expr (inquire->readwrite); gfc_free_expr (inquire->delim); + gfc_free_expr (inquire->encoding); gfc_free_expr (inquire->pad); gfc_free_expr (inquire->iolength); gfc_free_expr (inquire->convert); gfc_free_expr (inquire->strm_pos); + gfc_free_expr (inquire->asynchronous); + gfc_free_expr (inquire->decimal); + gfc_free_expr (inquire->pending); + gfc_free_expr (inquire->id); + gfc_free_expr (inquire->sign); + gfc_free_expr (inquire->size); + gfc_free_expr (inquire->round); gfc_free (inquire); } *************** match_inquire_element (gfc_inquire *inqu *** 3124,3134 **** --- 3602,3620 ---- RETM m = match_vtag (&tag_read, &inquire->read); RETM m = match_vtag (&tag_write, &inquire->write); RETM m = match_vtag (&tag_readwrite, &inquire->readwrite); + RETM m = match_vtag (&tag_s_async, &inquire->asynchronous); RETM m = match_vtag (&tag_s_delim, &inquire->delim); + RETM m = match_vtag (&tag_s_decimal, &inquire->decimal); + RETM m = match_vtag (&tag_size, &inquire->size); + RETM m = match_vtag (&tag_s_encoding, &inquire->encoding); + RETM m = match_vtag (&tag_s_round, &inquire->round); + RETM m = match_vtag (&tag_s_sign, &inquire->sign); RETM m = match_vtag (&tag_s_pad, &inquire->pad); RETM m = match_vtag (&tag_iolength, &inquire->iolength); RETM m = match_vtag (&tag_convert, &inquire->convert); RETM m = match_out_tag (&tag_strm_out, &inquire->strm_pos); + RETM m = match_vtag (&tag_pending, &inquire->pending); + RETM m = match_vtag (&tag_id, &inquire->id); RETM return MATCH_NO; } *************** gfc_match_inquire (void) *** 3147,3153 **** if (m == MATCH_NO) return m; ! inquire = gfc_getmem (sizeof (gfc_inquire)); loc = gfc_current_locus; --- 3633,3639 ---- if (m == MATCH_NO) return m; ! inquire = XCNEW (gfc_inquire); loc = gfc_current_locus; *************** gfc_match_inquire (void) *** 3236,3241 **** --- 3722,3734 ---- gfc_error ("INQUIRE statement not allowed in PURE procedure at %C"); goto cleanup; } + + if (inquire->id != NULL && inquire->pending == NULL) + { + gfc_error ("INQUIRE statement at %L requires a PENDING= specifier with " + "the ID= specifier", &loc); + goto cleanup; + } new_st.op = EXEC_INQUIRE; new_st.ext.inquire = inquire; *************** cleanup: *** 3252,3258 **** /* Resolve everything in a gfc_inquire structure. */ ! try gfc_resolve_inquire (gfc_inquire *inquire) { RESOLVE_TAG (&tag_unit, inquire->unit); --- 3745,3751 ---- /* Resolve everything in a gfc_inquire structure. */ ! gfc_try gfc_resolve_inquire (gfc_inquire *inquire) { RESOLVE_TAG (&tag_unit, inquire->unit); *************** gfc_resolve_inquire (gfc_inquire *inquir *** 3280,3291 **** --- 3773,3909 ---- RESOLVE_TAG (&tag_readwrite, inquire->readwrite); RESOLVE_TAG (&tag_s_delim, inquire->delim); RESOLVE_TAG (&tag_s_pad, inquire->pad); + RESOLVE_TAG (&tag_s_encoding, inquire->encoding); + RESOLVE_TAG (&tag_s_round, inquire->round); RESOLVE_TAG (&tag_iolength, inquire->iolength); RESOLVE_TAG (&tag_convert, inquire->convert); RESOLVE_TAG (&tag_strm_out, inquire->strm_pos); + RESOLVE_TAG (&tag_s_async, inquire->asynchronous); + RESOLVE_TAG (&tag_s_sign, inquire->sign); + RESOLVE_TAG (&tag_s_round, inquire->round); + RESOLVE_TAG (&tag_pending, inquire->pending); + RESOLVE_TAG (&tag_size, inquire->size); + RESOLVE_TAG (&tag_id, inquire->id); if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE) return FAILURE; return SUCCESS; } + + + void + gfc_free_wait (gfc_wait *wait) + { + if (wait == NULL) + return; + + gfc_free_expr (wait->unit); + gfc_free_expr (wait->iostat); + gfc_free_expr (wait->iomsg); + gfc_free_expr (wait->id); + } + + + gfc_try + gfc_resolve_wait (gfc_wait *wait) + { + RESOLVE_TAG (&tag_unit, wait->unit); + RESOLVE_TAG (&tag_iomsg, wait->iomsg); + RESOLVE_TAG (&tag_iostat, wait->iostat); + RESOLVE_TAG (&tag_id, wait->id); + + if (gfc_reference_st_label (wait->err, ST_LABEL_TARGET) == FAILURE) + return FAILURE; + + if (gfc_reference_st_label (wait->end, ST_LABEL_TARGET) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + /* Match an element of a WAIT statement. */ + + #define RETM if (m != MATCH_NO) return m; + + static match + match_wait_element (gfc_wait *wait) + { + match m; + + m = match_etag (&tag_unit, &wait->unit); + RETM m = match_ltag (&tag_err, &wait->err); + RETM m = match_ltag (&tag_end, &wait->eor); + RETM m = match_ltag (&tag_eor, &wait->end); + RETM m = match_out_tag (&tag_iomsg, &wait->iomsg); + RETM m = match_out_tag (&tag_iostat, &wait->iostat); + RETM m = match_etag (&tag_id, &wait->id); + RETM return MATCH_NO; + } + + #undef RETM + + + match + gfc_match_wait (void) + { + gfc_wait *wait; + match m; + locus loc; + + m = gfc_match_char ('('); + if (m == MATCH_NO) + return m; + + wait = XCNEW (gfc_wait); + + loc = gfc_current_locus; + + m = match_wait_element (wait); + if (m == MATCH_ERROR) + goto cleanup; + if (m == MATCH_NO) + { + m = gfc_match_expr (&wait->unit); + if (m == MATCH_ERROR) + goto cleanup; + if (m == MATCH_NO) + goto syntax; + } + + for (;;) + { + if (gfc_match_char (')') == MATCH_YES) + break; + if (gfc_match_char (',') != MATCH_YES) + goto syntax; + + m = match_wait_element (wait); + if (m == MATCH_ERROR) + goto cleanup; + if (m == MATCH_NO) + goto syntax; + } + + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: WAIT at %C " + "not allowed in Fortran 95") == FAILURE) + goto cleanup; + + if (gfc_pure (NULL)) + { + gfc_error ("WAIT statement not allowed in PURE procedure at %C"); + goto cleanup; + } + + new_st.op = EXEC_WAIT; + new_st.ext.wait = wait; + + return MATCH_YES; + + syntax: + gfc_syntax_error (ST_WAIT); + + cleanup: + gfc_free_wait (wait); + return MATCH_ERROR; + } diff -Nrcpad gcc-4.3.3/gcc/fortran/ioparm.def gcc-4.4.0/gcc/fortran/ioparm.def *** gcc-4.3.3/gcc/fortran/ioparm.def Thu Dec 28 01:39:15 2006 --- gcc-4.4.0/gcc/fortran/ioparm.def Sat Nov 22 08:10:41 2008 *************** *** 8,17 **** #define IOPARM_common_end (1 << 3) #define IOPARM_common_eor (1 << 4) #endif ! IOPARM (common, flags, 0, int4) ! IOPARM (common, unit, 0, int4) ! IOPARM (common, filename, 0, pchar) ! IOPARM (common, line, 0, int4) IOPARM (common, iomsg, 1 << 6, char2) IOPARM (common, iostat, 1 << 5, pint4) IOPARM (open, common, 0, common) --- 8,17 ---- #define IOPARM_common_end (1 << 3) #define IOPARM_common_eor (1 << 4) #endif ! IOPARM (common, flags, 0, int4) ! IOPARM (common, unit, 0, int4) ! IOPARM (common, filename, 0, pchar) ! IOPARM (common, line, 0, int4) IOPARM (common, iomsg, 1 << 6, char2) IOPARM (common, iostat, 1 << 5, pint4) IOPARM (open, common, 0, common) *************** IOPARM (open, position, 1 << 13, char *** 25,31 **** IOPARM (open, action, 1 << 14, char2) IOPARM (open, delim, 1 << 15, char1) IOPARM (open, pad, 1 << 16, char2) ! IOPARM (open, convert, 1 << 17, char1) IOPARM (close, common, 0, common) IOPARM (close, status, 1 << 7, char1) IOPARM (filepos, common, 0, common) --- 25,36 ---- IOPARM (open, action, 1 << 14, char2) IOPARM (open, delim, 1 << 15, char1) IOPARM (open, pad, 1 << 16, char2) ! IOPARM (open, convert, 1 << 17, char1) ! IOPARM (open, decimal, 1 << 18, char2) ! IOPARM (open, encoding, 1 << 19, char1) ! IOPARM (open, round, 1 << 20, char2) ! IOPARM (open, sign, 1 << 21, char1) ! IOPARM (open, asynchronous, 1 << 22, char2) IOPARM (close, common, 0, common) IOPARM (close, status, 1 << 7, char1) IOPARM (filepos, common, 0, common) *************** IOPARM (inquire, unformatted, 1 << 26, c *** 53,59 **** IOPARM (inquire, read, 1 << 27, char2) IOPARM (inquire, write, 1 << 28, char1) IOPARM (inquire, readwrite, 1 << 29, char2) ! IOPARM (inquire, convert, 1 << 30, char1) #ifndef IOPARM_dt_list_format #define IOPARM_dt_list_format (1 << 7) #define IOPARM_dt_namelist_read_mode (1 << 8) --- 58,75 ---- IOPARM (inquire, read, 1 << 27, char2) IOPARM (inquire, write, 1 << 28, char1) IOPARM (inquire, readwrite, 1 << 29, char2) ! IOPARM (inquire, convert, 1 << 30, char1) ! IOPARM (inquire, flags2, 1 << 31, int4) ! IOPARM (inquire, asynchronous, 1 << 0, char1) ! IOPARM (inquire, decimal, 1 << 1, char2) ! IOPARM (inquire, encoding, 1 << 2, char1) ! IOPARM (inquire, round, 1 << 3, char2) ! IOPARM (inquire, sign, 1 << 4, char1) ! IOPARM (inquire, pending, 1 << 5, pint4) ! IOPARM (inquire, size, 1 << 6, pint4) ! IOPARM (inquire, id, 1 << 7, pint4) ! IOPARM (wait, common, 0, common) ! IOPARM (wait, id, 1 << 7, pint4) #ifndef IOPARM_dt_list_format #define IOPARM_dt_list_format (1 << 7) #define IOPARM_dt_namelist_read_mode (1 << 8) *************** IOPARM (dt, format, 1 << 12, char1) *** 67,70 **** 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) --- 83,95 ---- 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) ! IOPARM (dt, blank, 1 << 19, char2) ! IOPARM (dt, decimal, 1 << 20, char1) ! IOPARM (dt, delim, 1 << 21, char2) ! IOPARM (dt, pad, 1 << 22, char1) ! IOPARM (dt, round, 1 << 23, char2) ! IOPARM (dt, sign, 1 << 24, char1) diff -Nrcpad gcc-4.3.3/gcc/fortran/iresolve.c gcc-4.4.0/gcc/fortran/iresolve.c *** gcc-4.3.3/gcc/fortran/iresolve.c Fri Apr 18 18:40:22 2008 --- gcc-4.4.0/gcc/fortran/iresolve.c Sat Nov 1 13:26:19 2008 *************** *** 1,5 **** /* Intrinsic function resolution. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb --- 1,5 ---- /* Intrinsic function resolution. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb *************** check_charlen_present (gfc_expr *source) *** 75,85 **** source->rank = 0; } else if (source->expr_type == EXPR_ARRAY) ! { ! source->ts.cl->length = gfc_int_expr (source->value.constructor->expr->value.character.length); - source->rank = 1; - } } /* Helper function for resolving the "mask" argument. */ --- 75,82 ---- source->rank = 0; } else if (source->expr_type == EXPR_ARRAY) ! source->ts.cl->length = gfc_int_expr (source->value.constructor->expr->value.character.length); } /* Helper function for resolving the "mask" argument. */ *************** resolve_mask_arg (gfc_expr *mask) *** 89,94 **** --- 86,92 ---- { gfc_typespec ts; + gfc_clear_ts (&ts); if (mask->rank == 0) { *************** resolve_mask_arg (gfc_expr *mask) *** 108,114 **** /* In the library, we access the mask with a GFC_LOGICAL_1 argument. No need to waste memory if we are about to create a temporary array. */ ! if (mask->expr_type == EXPR_OP) { ts.type = BT_LOGICAL; ts.kind = 1; --- 106,112 ---- /* In the library, we access the mask with a GFC_LOGICAL_1 argument. No need to waste memory if we are about to create a temporary array. */ ! if (mask->expr_type == EXPR_OP && mask->ts.kind != 1) { ts.type = BT_LOGICAL; ts.kind = 1; *************** gfc_resolve_access (gfc_expr *f, gfc_exp *** 142,147 **** --- 140,163 ---- } + void + gfc_resolve_adjustl (gfc_expr *f, gfc_expr *string) + { + f->ts.type = BT_CHARACTER; + f->ts.kind = string->ts.kind; + f->value.function.name = gfc_get_string ("__adjustl_s%d", f->ts.kind); + } + + + void + gfc_resolve_adjustr (gfc_expr *f, gfc_expr *string) + { + f->ts.type = BT_CHARACTER; + f->ts.kind = string->ts.kind; + f->value.function.name = gfc_get_string ("__adjustr_s%d", f->ts.kind); + } + + static void gfc_resolve_char_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind, const char *name) *************** void *** 220,225 **** --- 236,242 ---- gfc_resolve_aint (gfc_expr *f, gfc_expr *a, gfc_expr *kind) { gfc_typespec ts; + gfc_clear_ts (&ts); f->ts.type = a->ts.type; f->ts.kind = (kind == NULL) ? a->ts.kind : mpz_get_si (kind->value.integer); *************** void *** 266,271 **** --- 283,289 ---- gfc_resolve_anint (gfc_expr *f, gfc_expr *a, gfc_expr *kind) { gfc_typespec ts; + gfc_clear_ts (&ts); f->ts.type = a->ts.type; f->ts.kind = (kind == NULL) ? a->ts.kind : mpz_get_si (kind->value.integer); *************** void *** 360,365 **** --- 378,384 ---- gfc_resolve_besn (gfc_expr *f, gfc_expr *n, gfc_expr *x) { gfc_typespec ts; + gfc_clear_ts (&ts); f->ts = x->ts; if (n->ts.kind != gfc_c_int_kind) *************** gfc_resolve_cshift (gfc_expr *f, gfc_exp *** 585,590 **** --- 604,610 ---- if (shift->ts.kind < m) { gfc_typespec ts; + gfc_clear_ts (&ts); ts.type = BT_INTEGER; ts.kind = m; gfc_convert_type_warn (shift, &ts, 2, 0); *************** gfc_resolve_cshift (gfc_expr *f, gfc_exp *** 607,615 **** } } ! f->value.function.name ! = gfc_get_string (PREFIX ("cshift%d_%d%s"), n, shift->ts.kind, ! array->ts.type == BT_CHARACTER ? "_char" : ""); } --- 627,645 ---- } } ! if (array->ts.type == BT_CHARACTER) ! { ! if (array->ts.kind == gfc_default_character_kind) ! f->value.function.name ! = gfc_get_string (PREFIX ("cshift%d_%d_char"), n, shift->ts.kind); ! else ! f->value.function.name ! = gfc_get_string (PREFIX ("cshift%d_%d_char%d"), n, shift->ts.kind, ! array->ts.kind); ! } ! else ! f->value.function.name ! = gfc_get_string (PREFIX ("cshift%d_%d"), n, shift->ts.kind); } *************** void *** 617,622 **** --- 647,653 ---- gfc_resolve_ctime (gfc_expr *f, gfc_expr *time) { gfc_typespec ts; + gfc_clear_ts (&ts); f->ts.type = BT_CHARACTER; f->ts.kind = gfc_default_character_kind; *************** gfc_resolve_dot_product (gfc_expr *f, gf *** 674,680 **** temp.expr_type = EXPR_OP; gfc_clear_ts (&temp.ts); ! temp.value.op.operator = INTRINSIC_NONE; temp.value.op.op1 = a; temp.value.op.op2 = b; gfc_type_convert_binary (&temp); --- 705,711 ---- temp.expr_type = EXPR_OP; gfc_clear_ts (&temp.ts); ! temp.value.op.op = INTRINSIC_NONE; temp.value.op.op1 = a; temp.value.op.op2 = b; gfc_type_convert_binary (&temp); *************** gfc_resolve_eoshift (gfc_expr *f, gfc_ex *** 724,729 **** --- 755,761 ---- if (shift->ts.kind < m) { gfc_typespec ts; + gfc_clear_ts (&ts); ts.type = BT_INTEGER; ts.kind = m; gfc_convert_type_warn (shift, &ts, 2, 0); *************** gfc_resolve_eoshift (gfc_expr *f, gfc_ex *** 746,754 **** } } ! f->value.function.name ! = gfc_get_string (PREFIX ("eoshift%d_%d%s"), n, shift->ts.kind, ! array->ts.type == BT_CHARACTER ? "_char" : ""); } --- 778,796 ---- } } ! if (array->ts.type == BT_CHARACTER) ! { ! if (array->ts.kind == gfc_default_character_kind) ! f->value.function.name ! = gfc_get_string (PREFIX ("eoshift%d_%d_char"), n, shift->ts.kind); ! else ! f->value.function.name ! = gfc_get_string (PREFIX ("eoshift%d_%d_char%d"), n, shift->ts.kind, ! array->ts.kind); ! } ! else ! f->value.function.name ! = gfc_get_string (PREFIX ("eoshift%d_%d"), n, shift->ts.kind); } *************** gfc_resolve_hostnm (gfc_expr *f, gfc_exp *** 875,880 **** --- 917,930 ---- void + gfc_resolve_hypot (gfc_expr *f, gfc_expr *x, gfc_expr *y ATTRIBUTE_UNUSED) + { + f->ts = x->ts; + f->value.function.name = gfc_get_string ("__hypot_r%d", x->ts.kind); + } + + + void gfc_resolve_iand (gfc_expr *f, gfc_expr *i, gfc_expr *j) { /* If the kind of i and j are different, then g77 cross-promoted the *************** gfc_resolve_index_func (gfc_expr *f, gfc *** 1002,1007 **** --- 1052,1058 ---- gfc_expr *kind) { gfc_typespec ts; + gfc_clear_ts (&ts); f->ts.type = BT_INTEGER; if (kind) *************** void *** 1072,1077 **** --- 1123,1129 ---- gfc_resolve_isatty (gfc_expr *f, gfc_expr *u) { gfc_typespec ts; + gfc_clear_ts (&ts); f->ts.type = BT_LOGICAL; f->ts.kind = gfc_default_integer_kind; *************** gfc_resolve_malloc (gfc_expr *f, gfc_exp *** 1253,1258 **** --- 1305,1311 ---- if (size->ts.kind < gfc_index_integer_kind) { gfc_typespec ts; + gfc_clear_ts (&ts); ts.type = BT_INTEGER; ts.kind = gfc_index_integer_kind; *************** gfc_resolve_matmul (gfc_expr *f, gfc_exp *** 1279,1285 **** { temp.expr_type = EXPR_OP; gfc_clear_ts (&temp.ts); ! temp.value.op.operator = INTRINSIC_NONE; temp.value.op.op1 = a; temp.value.op.op2 = b; gfc_type_convert_binary (&temp); --- 1332,1338 ---- { temp.expr_type = EXPR_OP; gfc_clear_ts (&temp.ts); ! temp.value.op.op = INTRINSIC_NONE; temp.value.op.op1 = a; temp.value.op.op2 = b; gfc_type_convert_binary (&temp); *************** gfc_resolve_matmul (gfc_expr *f, gfc_exp *** 1288,1293 **** --- 1341,1374 ---- f->rank = (a->rank == 2 && b->rank == 2) ? 2 : 1; + if (a->rank == 2 && b->rank == 2) + { + if (a->shape && b->shape) + { + f->shape = gfc_get_shape (f->rank); + mpz_init_set (f->shape[0], a->shape[0]); + mpz_init_set (f->shape[1], b->shape[1]); + } + } + else if (a->rank == 1) + { + if (b->shape) + { + f->shape = gfc_get_shape (f->rank); + mpz_init_set (f->shape[0], b->shape[1]); + } + } + else + { + /* b->rank == 1 and a->rank == 2 here, all other cases have + been caught in check.c. */ + if (a->shape) + { + f->shape = gfc_get_shape (f->rank); + mpz_init_set (f->shape[0], a->shape[0]); + } + } + f->value.function.name = gfc_get_string (PREFIX ("matmul_%c%d"), gfc_type_letter (f->ts.type), f->ts.kind); *************** gfc_resolve_pack (gfc_expr *f, gfc_expr *** 1672,1682 **** resolve_mask_arg (mask); if (mask->rank != 0) ! f->value.function.name = (array->ts.type == BT_CHARACTER ! ? PREFIX ("pack_char") : PREFIX ("pack")); else ! f->value.function.name = (array->ts.type == BT_CHARACTER ! ? PREFIX ("pack_s_char") : PREFIX ("pack_s")); } --- 1753,1779 ---- resolve_mask_arg (mask); if (mask->rank != 0) ! { ! if (array->ts.type == BT_CHARACTER) ! f->value.function.name ! = array->ts.kind == 1 ? PREFIX ("pack_char") ! : gfc_get_string ! (PREFIX ("pack_char%d"), ! array->ts.kind); ! else ! f->value.function.name = PREFIX ("pack"); ! } else ! { ! if (array->ts.type == BT_CHARACTER) ! f->value.function.name ! = array->ts.kind == 1 ? PREFIX ("pack_s_char") ! : gfc_get_string ! (PREFIX ("pack_s_char%d"), ! array->ts.kind); ! else ! f->value.function.name = PREFIX ("pack_s"); ! } } *************** gfc_resolve_product (gfc_expr *f, gfc_ex *** 1691,1696 **** --- 1788,1794 ---- if (dim != NULL) { f->rank = array->rank - 1; + f->shape = gfc_copy_shape_excluding (array->shape, array->rank, dim); gfc_resolve_dim_arg (dim); } *************** gfc_resolve_reshape (gfc_expr *f, gfc_ex *** 1783,1788 **** --- 1881,1887 ---- case BT_REAL: case BT_INTEGER: case BT_LOGICAL: + case BT_CHARACTER: kind = source->ts.kind; break; *************** gfc_resolve_reshape (gfc_expr *f, gfc_ex *** 1802,1816 **** = gfc_get_string (PREFIX ("reshape_%c%d"), gfc_type_letter (source->ts.type), source->ts.kind); else f->value.function.name = gfc_get_string (PREFIX ("reshape_%d"), source->ts.kind); - break; default: f->value.function.name = (source->ts.type == BT_CHARACTER ! ? PREFIX ("reshape_char") : PREFIX ("reshape")); break; } --- 1901,1917 ---- = gfc_get_string (PREFIX ("reshape_%c%d"), gfc_type_letter (source->ts.type), source->ts.kind); + else if (source->ts.type == BT_CHARACTER) + f->value.function.name = gfc_get_string (PREFIX ("reshape_char%d"), + kind); else f->value.function.name = gfc_get_string (PREFIX ("reshape_%d"), source->ts.kind); break; default: f->value.function.name = (source->ts.type == BT_CHARACTER ! ? PREFIX ("reshape_char") : PREFIX ("reshape")); break; } *************** gfc_resolve_reshape (gfc_expr *f, gfc_ex *** 1845,1889 **** void gfc_resolve_rrspacing (gfc_expr *f, gfc_expr *x) { - int k; - gfc_actual_arglist *prec; - f->ts = x->ts; f->value.function.name = gfc_get_string ("__rrspacing_%d", x->ts.kind); - - /* Create a hidden argument to the library routines for rrspacing. This - hidden argument is the precision of x. */ - k = gfc_validate_kind (BT_REAL, x->ts.kind, false); - prec = gfc_get_actual_arglist (); - prec->name = "p"; - prec->expr = gfc_int_expr (gfc_real_kinds[k].digits); - /* The library routine expects INTEGER(4). */ - if (prec->expr->ts.kind != gfc_c_int_kind) - { - gfc_typespec ts; - ts.type = BT_INTEGER; - ts.kind = gfc_c_int_kind; - gfc_convert_type (prec->expr, &ts, 2); - } - f->value.function.actual->next = prec; } void ! gfc_resolve_scale (gfc_expr *f, gfc_expr *x, gfc_expr *i) { f->ts = x->ts; - - /* The implementation calls scalbn which takes an int as the - second argument. */ - if (i->ts.kind != gfc_c_int_kind) - { - gfc_typespec ts; - ts.type = BT_INTEGER; - ts.kind = gfc_c_int_kind; - gfc_convert_type_warn (i, &ts, 2, 0); - } - f->value.function.name = gfc_get_string ("__scale_%d", x->ts.kind); } --- 1946,1960 ---- void gfc_resolve_rrspacing (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name = gfc_get_string ("__rrspacing_%d", x->ts.kind); } void ! gfc_resolve_scale (gfc_expr *f, gfc_expr *x, gfc_expr *i ATTRIBUTE_UNUSED) { f->ts = x->ts; f->value.function.name = gfc_get_string ("__scale_%d", x->ts.kind); } *************** gfc_resolve_secnds (gfc_expr *t1, gfc_ex *** 1911,1931 **** void ! gfc_resolve_set_exponent (gfc_expr *f, gfc_expr *x, gfc_expr *i) { f->ts = x->ts; - - /* The library implementation uses GFC_INTEGER_4 unconditionally, - convert type so we don't have to implement all possible - permutations. */ - if (i->ts.kind != gfc_c_int_kind) - { - gfc_typespec ts; - ts.type = BT_INTEGER; - ts.kind = gfc_c_int_kind; - gfc_convert_type_warn (i, &ts, 2, 0); - } - f->value.function.name = gfc_get_string ("__set_exponent_%d", x->ts.kind); } --- 1982,1991 ---- void ! gfc_resolve_set_exponent (gfc_expr *f, gfc_expr *x, ! gfc_expr *i ATTRIBUTE_UNUSED) { f->ts = x->ts; f->value.function.name = gfc_get_string ("__set_exponent_%d", x->ts.kind); } *************** gfc_resolve_size (gfc_expr *f, gfc_expr *** 2005,2061 **** void gfc_resolve_spacing (gfc_expr *f, gfc_expr *x) { - int k; - gfc_actual_arglist *prec, *tiny, *emin_1; - f->ts = x->ts; f->value.function.name = gfc_get_string ("__spacing_%d", x->ts.kind); - - /* Create hidden arguments to the library routine for spacing. These - hidden arguments are tiny(x), min_exponent - 1, and the precision - of x. */ - - k = gfc_validate_kind (BT_REAL, x->ts.kind, false); - - tiny = gfc_get_actual_arglist (); - tiny->name = "tiny"; - tiny->expr = gfc_get_expr (); - tiny->expr->expr_type = EXPR_CONSTANT; - tiny->expr->where = gfc_current_locus; - tiny->expr->ts.type = x->ts.type; - tiny->expr->ts.kind = x->ts.kind; - mpfr_init (tiny->expr->value.real); - mpfr_set (tiny->expr->value.real, gfc_real_kinds[k].tiny, GFC_RND_MODE); - - emin_1 = gfc_get_actual_arglist (); - emin_1->name = "emin"; - emin_1->expr = gfc_int_expr (gfc_real_kinds[k].min_exponent - 1); - - /* The library routine expects INTEGER(4). */ - if (emin_1->expr->ts.kind != gfc_c_int_kind) - { - gfc_typespec ts; - ts.type = BT_INTEGER; - ts.kind = gfc_c_int_kind; - gfc_convert_type (emin_1->expr, &ts, 2); - } - emin_1->next = tiny; - - prec = gfc_get_actual_arglist (); - prec->name = "prec"; - prec->expr = gfc_int_expr (gfc_real_kinds[k].digits); - - /* The library routine expects INTEGER(4). */ - if (prec->expr->ts.kind != gfc_c_int_kind) - { - gfc_typespec ts; - ts.type = BT_INTEGER; - ts.kind = gfc_c_int_kind; - gfc_convert_type (prec->expr, &ts, 2); - } - prec->next = emin_1; - - f->value.function.actual->next = prec; } --- 2065,2072 ---- *************** gfc_resolve_spread (gfc_expr *f, gfc_exp *** 2072,2084 **** f->ts = source->ts; f->rank = source->rank + 1; if (source->rank == 0) ! f->value.function.name = (source->ts.type == BT_CHARACTER ! ? PREFIX ("spread_char_scalar") ! : PREFIX ("spread_scalar")); else ! f->value.function.name = (source->ts.type == BT_CHARACTER ! ? PREFIX ("spread_char") ! : PREFIX ("spread")); if (dim && gfc_is_constant_expr (dim) && ncopies && gfc_is_constant_expr (ncopies) && source->shape[0]) --- 2083,2109 ---- f->ts = source->ts; f->rank = source->rank + 1; if (source->rank == 0) ! { ! if (source->ts.type == BT_CHARACTER) ! f->value.function.name ! = source->ts.kind == 1 ? PREFIX ("spread_char_scalar") ! : gfc_get_string ! (PREFIX ("spread_char%d_scalar"), ! source->ts.kind); ! else ! f->value.function.name = PREFIX ("spread_scalar"); ! } else ! { ! if (source->ts.type == BT_CHARACTER) ! f->value.function.name ! = source->ts.kind == 1 ? PREFIX ("spread_char") ! : gfc_get_string ! (PREFIX ("spread_char%d"), ! source->ts.kind); ! else ! f->value.function.name = PREFIX ("spread"); ! } if (dim && gfc_is_constant_expr (dim) && ncopies && gfc_is_constant_expr (ncopies) && source->shape[0]) *************** void *** 2148,2153 **** --- 2173,2179 ---- gfc_resolve_fgetc (gfc_expr *f, gfc_expr *u, gfc_expr *c ATTRIBUTE_UNUSED) { gfc_typespec ts; + gfc_clear_ts (&ts); f->ts.type = BT_INTEGER; f->ts.kind = gfc_c_int_kind; *************** void *** 2177,2182 **** --- 2203,2209 ---- gfc_resolve_fputc (gfc_expr *f, gfc_expr *u, gfc_expr *c ATTRIBUTE_UNUSED) { gfc_typespec ts; + gfc_clear_ts (&ts); f->ts.type = BT_INTEGER; f->ts.kind = gfc_c_int_kind; *************** void *** 2206,2211 **** --- 2233,2239 ---- gfc_resolve_ftell (gfc_expr *f, gfc_expr *u) { gfc_typespec ts; + gfc_clear_ts (&ts); f->ts.type = BT_INTEGER; f->ts.kind = gfc_index_integer_kind; *************** gfc_resolve_sum (gfc_expr *f, gfc_expr * *** 2244,2249 **** --- 2272,2278 ---- if (dim != NULL) { f->rank = array->rank - 1; + f->shape = gfc_copy_shape_excluding (array->shape, array->rank, dim); gfc_resolve_dim_arg (dim); } *************** gfc_resolve_transpose (gfc_expr *f, gfc_ *** 2382,2388 **** break; default: ! f->value.function.name = PREFIX ("transpose"); break; } break; --- 2411,2420 ---- break; default: ! if (matrix->ts.type == BT_CHARACTER && matrix->ts.kind == 4) ! f->value.function.name = PREFIX ("transpose_char4"); ! else ! f->value.function.name = PREFIX ("transpose"); break; } break; *************** void *** 2453,2458 **** --- 2485,2491 ---- gfc_resolve_ttynam (gfc_expr *f, gfc_expr *unit) { gfc_typespec ts; + gfc_clear_ts (&ts); f->ts.type = BT_CHARACTER; f->ts.kind = gfc_default_character_kind; *************** gfc_resolve_unpack (gfc_expr *f, gfc_exp *** 2481,2489 **** f->rank = mask->rank; resolve_mask_arg (mask); ! f->value.function.name ! = gfc_get_string (PREFIX ("unpack%d%s"), field->rank > 0 ? 1 : 0, ! vector->ts.type == BT_CHARACTER ? "_char" : ""); } --- 2514,2532 ---- f->rank = mask->rank; resolve_mask_arg (mask); ! if (vector->ts.type == BT_CHARACTER) ! { ! if (vector->ts.kind == 1) ! f->value.function.name ! = gfc_get_string (PREFIX ("unpack%d_char"), field->rank > 0 ? 1 : 0); ! else ! f->value.function.name ! = gfc_get_string (PREFIX ("unpack%d_char%d"), ! field->rank > 0 ? 1 : 0, vector->ts.kind); ! } ! else ! f->value.function.name ! = gfc_get_string (PREFIX ("unpack%d"), field->rank > 0 ? 1 : 0); } *************** gfc_resolve_alarm_sub (gfc_code *c) *** 2528,2533 **** --- 2571,2577 ---- const char *name; gfc_expr *seconds, *handler, *status; gfc_typespec ts; + gfc_clear_ts (&ts); seconds = c->ext.actual->expr; handler = c->ext.actual->next->expr; *************** gfc_resolve_cpu_time (gfc_code *c) *** 2564,2574 **** --- 2608,2653 ---- } + /* Create a formal arglist based on an actual one and set the INTENTs given. */ + + static gfc_formal_arglist* + create_formal_for_intents (gfc_actual_arglist* actual, const sym_intent* ints) + { + gfc_formal_arglist* head; + gfc_formal_arglist* tail; + int i; + + if (!actual) + return NULL; + + head = tail = gfc_get_formal_arglist (); + for (i = 0; actual; actual = actual->next, tail = tail->next, ++i) + { + gfc_symbol* sym; + + sym = gfc_new_symbol ("dummyarg", NULL); + sym->ts = actual->expr->ts; + + sym->attr.intent = ints[i]; + tail->sym = sym; + + if (actual->next) + tail->next = gfc_get_formal_arglist (); + } + + return head; + } + + void gfc_resolve_mvbits (gfc_code *c) { + static const sym_intent INTENTS[] = {INTENT_IN, INTENT_IN, INTENT_IN, + INTENT_INOUT, INTENT_IN}; + const char *name; gfc_typespec ts; + gfc_clear_ts (&ts); /* FROMPOS, LEN and TOPOS are restricted to small values. As such, they will be converted so that they fit into a C int. */ *************** gfc_resolve_mvbits (gfc_code *c) *** 2587,2592 **** --- 2666,2675 ---- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); /* Mark as elemental subroutine as this does not happen automatically. */ c->resolved_sym->attr.elemental = 1; + + /* Create a dummy formal arglist so the INTENTs are known later for purpose + of creating temporaries. */ + c->resolved_sym->formal = create_formal_for_intents (c->ext.actual, INTENTS); } *************** gfc_resolve_getarg (gfc_code *c) *** 2782,2787 **** --- 2865,2871 ---- if (c->ext.actual->expr->ts.kind != gfc_default_integer_kind) { gfc_typespec ts; + gfc_clear_ts (&ts); ts.type = BT_INTEGER; ts.kind = gfc_default_integer_kind; *************** gfc_resolve_signal_sub (gfc_code *c) *** 2857,2862 **** --- 2941,2947 ---- const char *name; gfc_expr *number, *handler, *status; gfc_typespec ts; + gfc_clear_ts (&ts); number = c->ext.actual->expr; handler = c->ext.actual->next->expr; *************** gfc_resolve_exit (gfc_code *c) *** 2924,2929 **** --- 3009,3015 ---- const char *name; gfc_typespec ts; gfc_expr *n; + gfc_clear_ts (&ts); /* The STATUS argument has to be of default kind. If it is not, we convert it. */ *************** gfc_resolve_flush (gfc_code *c) *** 2946,2951 **** --- 3032,3038 ---- const char *name; gfc_typespec ts; gfc_expr *n; + gfc_clear_ts (&ts); ts.type = BT_INTEGER; ts.kind = gfc_default_integer_kind; *************** gfc_resolve_free (gfc_code *c) *** 2963,2968 **** --- 3050,3056 ---- { gfc_typespec ts; gfc_expr *n; + gfc_clear_ts (&ts); ts.type = BT_INTEGER; ts.kind = gfc_index_integer_kind; *************** void *** 2978,2983 **** --- 3066,3072 ---- gfc_resolve_ctime_sub (gfc_code *c) { gfc_typespec ts; + gfc_clear_ts (&ts); /* ctime TIME argument is a INTEGER(KIND=8), says the doc */ if (c->ext.actual->expr->ts.kind != 8) *************** gfc_resolve_fgetc_sub (gfc_code *c) *** 3078,3083 **** --- 3167,3173 ---- const char *name; gfc_typespec ts; gfc_expr *u, *st; + gfc_clear_ts (&ts); u = c->ext.actual->expr; st = c->ext.actual->next->next->expr; *************** gfc_resolve_fputc_sub (gfc_code *c) *** 3122,3127 **** --- 3212,3218 ---- const char *name; gfc_typespec ts; gfc_expr *u, *st; + gfc_clear_ts (&ts); u = c->ext.actual->expr; st = c->ext.actual->next->next->expr; *************** gfc_resolve_fseek_sub (gfc_code *c) *** 3168,3173 **** --- 3259,3265 ---- gfc_expr *whence; gfc_expr *status; gfc_typespec ts; + gfc_clear_ts (&ts); unit = c->ext.actual->expr; offset = c->ext.actual->next->expr; *************** gfc_resolve_ftell_sub (gfc_code *c) *** 3211,3216 **** --- 3303,3309 ---- gfc_expr *unit; gfc_expr *offset; gfc_typespec ts; + gfc_clear_ts (&ts); unit = c->ext.actual->expr; offset = c->ext.actual->next->expr; *************** void *** 3233,3238 **** --- 3326,3332 ---- gfc_resolve_ttynam_sub (gfc_code *c) { gfc_typespec ts; + gfc_clear_ts (&ts); if (c->ext.actual->expr->ts.kind != gfc_c_int_kind) { diff -Nrcpad gcc-4.3.3/gcc/fortran/iso-c-binding.def gcc-4.4.0/gcc/fortran/iso-c-binding.def *** gcc-4.3.3/gcc/fortran/iso-c-binding.def Wed Aug 1 16:29:36 2007 --- gcc-4.4.0/gcc/fortran/iso-c-binding.def Thu May 15 12:46:54 2008 *************** *** 1,4 **** ! /* Copyright (C) 2006, 2007 Free Software Foundation, Inc. This file is part of GCC. --- 1,4 ---- ! /* Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. This file is part of GCC. *************** along with GCC; see the file COPYING3. *** 20,26 **** Fortran 2003 ISO_C_BINDING intrinsic module. */ #ifndef NAMED_INTCST ! # define NAMED_INTCST(a,b,c) #endif #ifndef NAMED_REALCST --- 20,26 ---- Fortran 2003 ISO_C_BINDING intrinsic module. */ #ifndef NAMED_INTCST ! # define NAMED_INTCST(a,b,c,d) #endif #ifndef NAMED_REALCST *************** along with GCC; see the file COPYING3. *** 42,85 **** /* The arguments to NAMED_*CST are: -- an internal name -- the symbol name in the module, as seen by Fortran code ! -- the value it has, for use in trans-types.c */ ! NAMED_INTCST (ISOCBINDING_INT, "c_int", gfc_c_int_kind) NAMED_INTCST (ISOCBINDING_SHORT, "c_short", \ ! get_int_kind_from_node (short_integer_type_node)) NAMED_INTCST (ISOCBINDING_LONG, "c_long", \ ! get_int_kind_from_node (long_integer_type_node)) NAMED_INTCST (ISOCBINDING_LONG_LONG, "c_long_long", \ ! get_int_kind_from_node (long_long_integer_type_node)) NAMED_INTCST (ISOCBINDING_INTMAX_T, "c_intmax_t", \ ! get_int_kind_from_node (intmax_type_node)) NAMED_INTCST (ISOCBINDING_INTPTR_T, "c_intptr_t", \ ! get_int_kind_from_node (ptr_type_node)) NAMED_INTCST (ISOCBINDING_SIZE_T, "c_size_t", \ ! gfc_index_integer_kind) NAMED_INTCST (ISOCBINDING_SIGNED_CHAR, "c_signed_char", \ ! get_int_kind_from_node (signed_char_type_node)) ! NAMED_INTCST (ISOCBINDING_INT8_T, "c_int8_t", get_int_kind_from_width (8)) ! NAMED_INTCST (ISOCBINDING_INT16_T, "c_int16_t", get_int_kind_from_width (16)) ! NAMED_INTCST (ISOCBINDING_INT32_T, "c_int32_t", get_int_kind_from_width (32)) ! NAMED_INTCST (ISOCBINDING_INT64_T, "c_int64_t", get_int_kind_from_width (64)) NAMED_INTCST (ISOCBINDING_INT_LEAST8_T, "c_int_least8_t", \ ! get_int_kind_from_minimal_width (8)) NAMED_INTCST (ISOCBINDING_INT_LEAST16_T, "c_int_least16_t", \ ! get_int_kind_from_minimal_width (16)) NAMED_INTCST (ISOCBINDING_INT_LEAST32_T, "c_int_least32_t", \ ! get_int_kind_from_minimal_width (32)) NAMED_INTCST (ISOCBINDING_INT_LEAST64_T, "c_int_least64_t", \ ! get_int_kind_from_minimal_width (64)) /* TODO: Implement c_int_fast*_t. Depends on PR 448. */ ! NAMED_INTCST (ISOCBINDING_INT_FAST8_T, "c_int_fast8_t", -2) ! NAMED_INTCST (ISOCBINDING_INT_FAST16_T, "c_int_fast16_t", -2) ! NAMED_INTCST (ISOCBINDING_INT_FAST32_T, "c_int_fast32_t", -2) ! NAMED_INTCST (ISOCBINDING_INT_FAST64_T, "c_int_fast64_t", -2) NAMED_REALCST (ISOCBINDING_FLOAT, "c_float", \ get_real_kind_from_node (float_type_node)) --- 42,98 ---- /* The arguments to NAMED_*CST are: -- an internal name -- the symbol name in the module, as seen by Fortran code ! -- the value it has, for use in trans-types.c ! -- the standard that supports this type */ ! NAMED_INTCST (ISOCBINDING_INT, "c_int", gfc_c_int_kind, GFC_STD_F2003) NAMED_INTCST (ISOCBINDING_SHORT, "c_short", \ ! get_int_kind_from_node (short_integer_type_node), GFC_STD_F2003) NAMED_INTCST (ISOCBINDING_LONG, "c_long", \ ! get_int_kind_from_node (long_integer_type_node), GFC_STD_F2003) NAMED_INTCST (ISOCBINDING_LONG_LONG, "c_long_long", \ ! get_int_kind_from_node (long_long_integer_type_node), GFC_STD_F2003) NAMED_INTCST (ISOCBINDING_INTMAX_T, "c_intmax_t", \ ! get_int_kind_from_node (intmax_type_node), GFC_STD_F2003) NAMED_INTCST (ISOCBINDING_INTPTR_T, "c_intptr_t", \ ! get_int_kind_from_node (ptr_type_node), GFC_STD_F2003) NAMED_INTCST (ISOCBINDING_SIZE_T, "c_size_t", \ ! gfc_index_integer_kind, GFC_STD_F2003) NAMED_INTCST (ISOCBINDING_SIGNED_CHAR, "c_signed_char", \ ! get_int_kind_from_node (signed_char_type_node), GFC_STD_F2003) ! NAMED_INTCST (ISOCBINDING_INT8_T, "c_int8_t", get_int_kind_from_width (8), \ ! GFC_STD_F2003) ! NAMED_INTCST (ISOCBINDING_INT16_T, "c_int16_t", get_int_kind_from_width (16), \ ! GFC_STD_F2003) ! NAMED_INTCST (ISOCBINDING_INT32_T, "c_int32_t", get_int_kind_from_width (32), \ ! GFC_STD_F2003) ! NAMED_INTCST (ISOCBINDING_INT64_T, "c_int64_t", get_int_kind_from_width (64), \ ! GFC_STD_F2003) ! /* GNU Extension. */ ! NAMED_INTCST (ISOCBINDING_INT128_T, "c_int128_t", get_int_kind_from_width (128), \ ! GFC_STD_GNU) NAMED_INTCST (ISOCBINDING_INT_LEAST8_T, "c_int_least8_t", \ ! get_int_kind_from_minimal_width (8), GFC_STD_F2003) NAMED_INTCST (ISOCBINDING_INT_LEAST16_T, "c_int_least16_t", \ ! get_int_kind_from_minimal_width (16), GFC_STD_F2003) NAMED_INTCST (ISOCBINDING_INT_LEAST32_T, "c_int_least32_t", \ ! get_int_kind_from_minimal_width (32), GFC_STD_F2003) NAMED_INTCST (ISOCBINDING_INT_LEAST64_T, "c_int_least64_t", \ ! get_int_kind_from_minimal_width (64), GFC_STD_F2003) ! /* GNU Extension. */ ! NAMED_INTCST (ISOCBINDING_INT_LEAST128_T, "c_int_least128_t", \ ! get_int_kind_from_minimal_width (128), GFC_STD_GNU) /* TODO: Implement c_int_fast*_t. Depends on PR 448. */ ! NAMED_INTCST (ISOCBINDING_INT_FAST8_T, "c_int_fast8_t", -2, GFC_STD_F2003) ! NAMED_INTCST (ISOCBINDING_INT_FAST16_T, "c_int_fast16_t", -2, GFC_STD_F2003) ! NAMED_INTCST (ISOCBINDING_INT_FAST32_T, "c_int_fast32_t", -2, GFC_STD_F2003) ! NAMED_INTCST (ISOCBINDING_INT_FAST64_T, "c_int_fast64_t", -2, GFC_STD_F2003) ! /* GNU Extension. */ ! NAMED_INTCST (ISOCBINDING_INT_FAST128_T, "c_int_fast128_t", -2, GFC_STD_GNU) NAMED_REALCST (ISOCBINDING_FLOAT, "c_float", \ get_real_kind_from_node (float_type_node)) diff -Nrcpad gcc-4.3.3/gcc/fortran/iso-fortran-env.def gcc-4.4.0/gcc/fortran/iso-fortran-env.def *** gcc-4.3.3/gcc/fortran/iso-fortran-env.def Mon Sep 3 16:44:15 2007 --- gcc-4.4.0/gcc/fortran/iso-fortran-env.def Thu May 15 12:47:36 2008 *************** *** 1,4 **** ! /* Copyright (C) 2006, 2007 Free Software Foundation, Inc. This file is part of GCC. --- 1,4 ---- ! /* Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. This file is part of GCC. *************** along with GCC; see the file COPYING3. *** 22,36 **** /* The arguments to NAMED_INTCST are: -- an internal name -- the symbol name in the module, as seen by Fortran code ! -- the value it has */ NAMED_INTCST (ISOFORTRANENV_CHARACTER_STORAGE_SIZE, "character_storage_size", \ ! gfc_character_storage_size) ! NAMED_INTCST (ISOFORTRANENV_ERROR_UNIT, "error_unit", GFC_STDERR_UNIT_NUMBER) ! NAMED_INTCST (ISOFORTRANENV_FILE_STORAGE_SIZE, "file_storage_size", 8) ! NAMED_INTCST (ISOFORTRANENV_INPUT_UNIT, "input_unit", GFC_STDIN_UNIT_NUMBER) ! NAMED_INTCST (ISOFORTRANENV_IOSTAT_END, "iostat_end", LIBERROR_END) ! NAMED_INTCST (ISOFORTRANENV_IOSTAT_EOR, "iostat_eor", LIBERROR_EOR) NAMED_INTCST (ISOFORTRANENV_NUMERIC_STORAGE_SIZE, "numeric_storage_size", \ ! gfc_numeric_storage_size) ! NAMED_INTCST (ISOFORTRANENV_OUTPUT_UNIT, "output_unit", GFC_STDOUT_UNIT_NUMBER) --- 22,43 ---- /* The arguments to NAMED_INTCST are: -- an internal name -- the symbol name in the module, as seen by Fortran code ! -- the value it has ! -- the standard that supports this type */ NAMED_INTCST (ISOFORTRANENV_CHARACTER_STORAGE_SIZE, "character_storage_size", \ ! gfc_character_storage_size, GFC_STD_F2003) ! NAMED_INTCST (ISOFORTRANENV_ERROR_UNIT, "error_unit", GFC_STDERR_UNIT_NUMBER, \ ! GFC_STD_F2003) ! NAMED_INTCST (ISOFORTRANENV_FILE_STORAGE_SIZE, "file_storage_size", 8, \ ! GFC_STD_F2003) ! NAMED_INTCST (ISOFORTRANENV_INPUT_UNIT, "input_unit", GFC_STDIN_UNIT_NUMBER, \ ! GFC_STD_F2003) ! NAMED_INTCST (ISOFORTRANENV_IOSTAT_END, "iostat_end", LIBERROR_END, \ ! GFC_STD_F2003) ! NAMED_INTCST (ISOFORTRANENV_IOSTAT_EOR, "iostat_eor", LIBERROR_EOR, \ ! GFC_STD_F2003) NAMED_INTCST (ISOFORTRANENV_NUMERIC_STORAGE_SIZE, "numeric_storage_size", \ ! gfc_numeric_storage_size, GFC_STD_F2003) ! NAMED_INTCST (ISOFORTRANENV_OUTPUT_UNIT, "output_unit", GFC_STDOUT_UNIT_NUMBER, \ ! GFC_STD_F2003) diff -Nrcpad gcc-4.3.3/gcc/fortran/lang-specs.h gcc-4.4.0/gcc/fortran/lang-specs.h *** gcc-4.3.3/gcc/fortran/lang-specs.h Sat Oct 27 14:43:53 2007 --- gcc-4.4.0/gcc/fortran/lang-specs.h Tue Dec 9 19:53:02 2008 *************** *** 1,6 **** /* Contribution to the specs for the GNU Compiler Collection from GNU Fortran 95 compiler. ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. This file is free software; you can redistribute it and/or modify --- 1,6 ---- /* Contribution to the specs for the GNU Compiler Collection from GNU Fortran 95 compiler. ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. This file is free software; you can redistribute it and/or modify *************** *** 20,52 **** /* This is the contribution to the `default_compilers' array in gcc.c for the f95 language. */ {".F", "@f77-cpp-input", 0, 0, 0}, {".FOR", "@f77-cpp-input", 0, 0, 0}, {".FTN", "@f77-cpp-input", 0, 0, 0}, {".fpp", "@f77-cpp-input", 0, 0, 0}, {".FPP", "@f77-cpp-input", 0, 0, 0}, {"@f77-cpp-input", ! "cc1 -E -lang-fortran -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \ ! %{E|M|MM:%(cpp_debug_options)}\ ! %{!M:%{!MM:%{!E: -o %|.f |\n\ ! f951 %|.f %{!ffree-form:-ffixed-form} %(cc1_options) %{J*} %{I*}\ ! -fpreprocessed %{!nostdinc:-fintrinsic-modules-path finclude%s} %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0}, {".F90", "@f95-cpp-input", 0, 0, 0}, {".F95", "@f95-cpp-input", 0, 0, 0}, {".F03", "@f95-cpp-input", 0, 0, 0}, {"@f95-cpp-input", ! "cc1 -E -lang-fortran -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \ ! %{E|M|MM:%(cpp_debug_options)}\ ! %{!M:%{!MM:%{!E: -o %|.f95 |\n\ ! f951 %|.f95 %{!ffixed-form:-ffree-form} %(cc1_options) %{J*} %{I*}\ ! -fpreprocessed %{!nostdinc:-fintrinsic-modules-path finclude%s} %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0}, {".f90", "@f95", 0, 0, 0}, {".f95", "@f95", 0, 0, 0}, {".f03", "@f95", 0, 0, 0}, ! {"@f95", "%{!E:f951 %i %(cc1_options) %{J*} %{I*}\ ! %{!nostdinc:-fintrinsic-modules-path finclude%s} %{!fsyntax-only:%(invoke_as)}}", 0, 0, 0}, ! {".f", "@f77", 0, 0, 0}, ! {".for", "@f77", 0, 0, 0}, ! {".ftn", "@f77", 0, 0, 0}, ! {"@f77", "%{!E:f951 %i %{!ffree-form:-ffixed-form} %(cc1_options) %{J*} %{I*}\ ! %{!nostdinc:-fintrinsic-modules-path finclude%s} %{!fsyntax-only:%(invoke_as)}}", 0, 0, 0}, --- 20,78 ---- /* This is the contribution to the `default_compilers' array in gcc.c for the f95 language. */ + /* Identical to gcc.c (cpp_options), but omitting %(cpp_unique_options) + and -fpch-preprocess on -save-temps. */ + #define CPP_ONLY_OPTIONS "%1 %{m*} %{f*} %{g*:%{!g0:%{g*} \ + %{!fno-working-directory:-fworking-directory}}} \ + %{std*&ansi&trigraphs} %{W*&pedantic*} %{w} \ + %{O*} %{undef}" + + /* Options that f951 should know about, even if not preprocessing. */ + #define CPP_FORWARD_OPTIONS "%{i*} %{I*}" + + #define F951_CPP_OPTIONS "%{!nocpp: -cpp %g.f90 %{E} %(cpp_unique_options) \ + %{E|M|MM:%(cpp_debug_options) " CPP_ONLY_OPTIONS \ + " -fsyntax-only};: " CPP_FORWARD_OPTIONS "}" + #define F951_OPTIONS "%(cc1_options) %{J*} \ + %{!nostdinc:-fintrinsic-modules-path finclude%s}\ + %{!fsyntax-only:%(invoke_as)}" + #define F951_SOURCE_FORM "%{!ffree-form:-ffixed-form}" + + {".F", "@f77-cpp-input", 0, 0, 0}, {".FOR", "@f77-cpp-input", 0, 0, 0}, {".FTN", "@f77-cpp-input", 0, 0, 0}, {".fpp", "@f77-cpp-input", 0, 0, 0}, {".FPP", "@f77-cpp-input", 0, 0, 0}, {"@f77-cpp-input", ! "f951 %i " F951_SOURCE_FORM " " \ ! F951_CPP_OPTIONS " %{!E:" F951_OPTIONS "}", 0, 0, 0}, ! {".f", "@f77", 0, 0, 0}, ! {".for", "@f77", 0, 0, 0}, ! {".ftn", "@f77", 0, 0, 0}, ! {"@f77", ! "f951 %i " F951_SOURCE_FORM " \ ! %{E:%{!cpp:%egfortran does not support -E without -cpp}} \ ! %{cpp:" F951_CPP_OPTIONS ";: " CPP_FORWARD_OPTIONS "} \ ! %{!E:" F951_OPTIONS "}", 0, 0, 0}, {".F90", "@f95-cpp-input", 0, 0, 0}, {".F95", "@f95-cpp-input", 0, 0, 0}, {".F03", "@f95-cpp-input", 0, 0, 0}, + {".F08", "@f95-cpp-input", 0, 0, 0}, {"@f95-cpp-input", ! "f951 %i " F951_CPP_OPTIONS " %{!E:" F951_OPTIONS "}", 0, 0, 0}, {".f90", "@f95", 0, 0, 0}, {".f95", "@f95", 0, 0, 0}, {".f03", "@f95", 0, 0, 0}, ! {".f08", "@f95", 0, 0, 0}, ! {"@f95", ! "f951 %i %{E:%{!cpp:%egfortran does not support -E without -cpp}}\ ! %{cpp:" F951_CPP_OPTIONS ";: " CPP_FORWARD_OPTIONS "} \ ! %{!E:" F951_OPTIONS "}", 0, 0, 0}, ! ! ! #undef CPP_ONLY_OPTIONS ! #undef CPP_FORWARD_OPTIONS ! #undef F951_SOURCE_FORM ! #undef F951_CPP_OPTIONS ! #undef F951_OPTIONS diff -Nrcpad gcc-4.3.3/gcc/fortran/lang.opt gcc-4.4.0/gcc/fortran/lang.opt *** gcc-4.3.3/gcc/fortran/lang.opt Sun Feb 10 15:01:39 2008 --- gcc-4.4.0/gcc/fortran/lang.opt Wed Mar 18 21:14:53 2009 *************** *** 1,5 **** ; Options for the Fortran 95 front end. ! ; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. ; ; This file is part of GCC. ; --- 1,6 ---- ; Options for the Fortran 95 front end. ! ; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009 ! ; Free Software Foundation, Inc. ; ; This file is part of GCC. ; *************** *** 24,37 **** Language Fortran I Fortran Joined Separate ! -I Add a directory for INCLUDE and MODULE searching J Fortran Joined Separate -J Put MODULE files in 'directory' Wall Fortran ; Documented in C --- 25,69 ---- Language Fortran + A + Fortran Joined Separate + ; Documented in C + + C + Fortran + ; Documented in C + + CC + Fortran + ; Documented in C + + D + Fortran Joined Separate + ; Documented in C + + E + Fortran Undocumented + + H + Fortran + ; Documented in C + I Fortran Joined Separate ! ; Documented in C J Fortran Joined Separate -J Put MODULE files in 'directory' + P + Fortran + ; Documented in C + + U + Fortran Joined Separate + ; Documented in C + Wall Fortran ; Documented in C *************** Waliasing *** 40,56 **** Fortran Warning Warn about possible aliasing of dummy arguments Wampersand Fortran Warning Warn about missing ampersand in continued character constants Wcharacter-truncation Fortran Warning Warn about truncated character expressions Wconversion Fortran Warning ! Warn about implicit conversion Wimplicit-interface Fortran Warning --- 72,96 ---- Fortran Warning Warn about possible aliasing of dummy arguments + Walign-commons + Fortran Warning + Warn about alignment of COMMON blocks + Wampersand Fortran Warning Warn about missing ampersand in continued character constants + Warray-temporaries + Fortran Warning + Warn about creation of array temporaries + Wcharacter-truncation Fortran Warning Warn about truncated character expressions Wconversion Fortran Warning ! ; Documented in C Wimplicit-interface Fortran Warning *************** Wline-truncation *** 60,68 **** Fortran Warning Warn about truncated source lines ! Wnonstd-intrinsics Fortran Warning ! Warn about usage of non-standard intrinsics Wsurprising Fortran Warning --- 100,112 ---- Fortran Warning Warn about truncated source lines ! Wintrinsics-std Fortran Warning ! Warn on intrinsics not part of the selected standard ! ! Wreturn-type ! Fortran Warning ! ; Documented in C Wsurprising Fortran Warning *************** Wunderflow *** 76,81 **** --- 120,145 ---- Fortran Warning Warn about underflow of numerical constant expressions + Wintrinsic-shadow + Fortran Warning + Warn if a user-procedure has the same name as an intrinsic + + cpp + Fortran Joined Separate Negative(nocpp) + Enable preprocessing + + nocpp + Fortran Negative(cpp) + Disable preprocessing + + d + Fortran Joined + ; Documented in common.opt + + falign-commons + Fortran + Enable alignment of COMMON blocks + fall-intrinsics Fortran RejectNegative All intrinsics procedures are available regardless of selected standard *************** fblas-matmul-limit= *** 100,105 **** --- 164,173 ---- Fortran RejectNegative Joined UInteger -fblas-matmul-limit= Size of the smallest matrix for which matmul will use BLAS + fcheck-array-temporaries + Fortran + Produce a warning at runtime if a array temporary has been created for a procedure argument + fconvert=big-endian Fortran RejectNegative Use big-endian format for unformatted files *************** finit-real= *** 216,221 **** --- 284,293 ---- Fortran RejectNegative Joined -finit-real= Initialize local real variables + fmax-array-constructor= + Fortran RejectNegative Joined UInteger + -fmax-array-constructor= Maximum number of objects in an array constructor + fmax-errors= Fortran RejectNegative Joined UInteger -fmax-errors= Maximum number of errors to report *************** Set default accessibility of module enti *** 238,244 **** fopenmp Fortran ! Enable OpenMP (also sets frecursive) fpack-derived Fortran --- 310,316 ---- fopenmp Fortran ! ; Documented in C fpack-derived Fortran *************** Try to lay out derived types as compactl *** 246,252 **** fpreprocessed Fortran ! Treat the input file as preprocessed frange-check Fortran --- 318,324 ---- fpreprocessed Fortran ! ; Documented in C frange-check Fortran *************** funderscoring *** 284,289 **** --- 356,397 ---- Fortran Append underscores to externally visible names + fworking-directory + Fortran + ; Documented in C + + idirafter + Fortran Joined Separate + ; Documented in C + + imultilib + Fortran Joined Separate + ; Documented in C + + iprefix + Fortran Joined Separate + ; Documented in C + + iquote + Fortran Joined Separate + ; Documented in C + + isysroot + Fortran Joined Separate + ; Documented in C + + isystem + Fortran Joined Separate + ; Documented in C + + nostdinc + Fortran + ; Documented in C + + o + Fortran Joined Separate + ; Documented in common.opt + static-libgfortran Fortran Statically link the GNU Fortran helper library (libgfortran) *************** std=f2003 *** 292,297 **** --- 400,409 ---- Fortran Conform to the ISO Fortran 2003 standard + std=f2008 + Fortran + Conform to the ISO Fortran 2008 standard + std=f95 Fortran Conform to the ISO Fortran 95 standard *************** std=legacy *** 304,307 **** --- 416,427 ---- Fortran Accept extensions to support legacy code + undef + Fortran + ; Documented in C + + v + Fortran + ; Documented in C + ; This comment is to ensure we retain the blank line above. diff -Nrcpad gcc-4.3.3/gcc/fortran/libgfortran.h gcc-4.4.0/gcc/fortran/libgfortran.h *** gcc-4.3.3/gcc/fortran/libgfortran.h Mon Sep 3 16:44:15 2007 --- gcc-4.4.0/gcc/fortran/libgfortran.h Sat Aug 16 15:53:14 2008 *************** *** 1,5 **** /* Header file to the Fortran front-end and runtime library ! Copyright (C) 2007 Free Software Foundation, Inc. This file is part of GCC. --- 1,5 ---- /* Header file to the Fortran front-end and runtime library ! Copyright (C) 2007, 2008 Free Software Foundation, Inc. This file is part of GCC. *************** along with GCC; see the file COPYING3. *** 20,25 **** --- 20,26 ---- /* Flags to specify which standard/extension contains a feature. Note that no features were obsoleted nor deleted in F2003. */ + #define GFC_STD_F2008 (1<<7) /* New in F2008. */ #define GFC_STD_LEGACY (1<<6) /* Backward compatibility. */ #define GFC_STD_GNU (1<<5) /* GNU Fortran extension. */ #define GFC_STD_F2003 (1<<4) /* New in F2003. */ *************** libgfortran_error_codes; *** 87,92 **** --- 88,95 ---- #define GFC_STDERR_UNIT_NUMBER 0 + /* FIXME: Increase to 15 for Fortran 2008. Also needs changes to + GFC_DTYPE_RANK_MASK. See PR 36825. */ #define GFC_MAX_DIMENSIONS 7 #define GFC_DTYPE_RANK_MASK 0x07 diff -Nrcpad gcc-4.3.3/gcc/fortran/match.c gcc-4.4.0/gcc/fortran/match.c *** gcc-4.3.3/gcc/fortran/match.c Wed Sep 24 08:12:47 2008 --- gcc-4.4.0/gcc/fortran/match.c Thu Sep 25 15:01:16 2008 *************** *** 1,5 **** /* Matching subroutines in all sizes, shapes and colors. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Matching subroutines in all sizes, shapes and colors. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Andy Vaught *************** along with GCC; see the file COPYING3. *** 26,31 **** --- 26,33 ---- #include "match.h" #include "parse.h" + int gfc_matching_procptr_assignment = 0; + bool gfc_matching_prefix = false; /* For debugging and diagnostic purposes. Return the textual representation of the intrinsic operator OP. */ *************** match *** 111,118 **** gfc_match_parens (void) { locus old_loc, where; ! int c, count, instring; ! char quote; old_loc = gfc_current_locus; count = 0; --- 113,120 ---- gfc_match_parens (void) { locus old_loc, where; ! int count, instring; ! gfc_char_t c, quote; old_loc = gfc_current_locus; count = 0; *************** gfc_match_parens (void) *** 126,132 **** break; if (quote == ' ' && ((c == '\'') || (c == '"'))) { ! quote = (char) c; instring = 1; continue; } --- 128,134 ---- break; if (quote == ' ' && ((c == '\'') || (c == '"'))) { ! quote = c; instring = 1; continue; } *************** gfc_match_parens (void) *** 153,164 **** if (count > 0) { ! gfc_error ("Missing ')' in statement before %L", &where); return MATCH_ERROR; } if (count < 0) { ! gfc_error ("Missing '(' in statement before %L", &where); return MATCH_ERROR; } --- 155,166 ---- if (count > 0) { ! gfc_error ("Missing ')' in statement at or before %L", &where); return MATCH_ERROR; } if (count < 0) { ! gfc_error ("Missing '(' in statement at or before %L", &where); return MATCH_ERROR; } *************** gfc_match_parens (void) *** 170,211 **** escaped by a \ via the -fbackslash option. */ match ! gfc_match_special_char (int *c) { ! match m; m = MATCH_YES; ! switch (gfc_next_char_literal (1)) { case 'a': ! *c = '\a'; break; case 'b': ! *c = '\b'; break; case 't': ! *c = '\t'; break; case 'f': ! *c = '\f'; break; case 'n': ! *c = '\n'; break; case 'r': ! *c = '\r'; break; case 'v': ! *c = '\v'; break; case '\\': ! *c = '\\'; break; case '0': ! *c = '\0'; break; default: /* Unknown backslash codes are simply not expanded. */ m = MATCH_NO; --- 172,237 ---- escaped by a \ via the -fbackslash option. */ match ! gfc_match_special_char (gfc_char_t *res) { ! int len, i; ! gfc_char_t c, n; match m; m = MATCH_YES; ! switch ((c = gfc_next_char_literal (1))) { case 'a': ! *res = '\a'; break; case 'b': ! *res = '\b'; break; case 't': ! *res = '\t'; break; case 'f': ! *res = '\f'; break; case 'n': ! *res = '\n'; break; case 'r': ! *res = '\r'; break; case 'v': ! *res = '\v'; break; case '\\': ! *res = '\\'; break; case '0': ! *res = '\0'; ! break; ! ! case 'x': ! case 'u': ! case 'U': ! /* Hexadecimal form of wide characters. */ ! len = (c == 'x' ? 2 : (c == 'u' ? 4 : 8)); ! n = 0; ! for (i = 0; i < len; i++) ! { ! char buf[2] = { '\0', '\0' }; ! ! c = gfc_next_char_literal (1); ! if (!gfc_wide_fits_in_byte (c) ! || !gfc_check_digit ((unsigned char) c, 16)) ! return MATCH_NO; ! ! buf[0] = (unsigned char) c; ! n = n << 4; ! n += strtol (buf, NULL, 16); ! } ! *res = n; break; + default: /* Unknown backslash codes are simply not expanded. */ m = MATCH_NO; *************** match *** 223,236 **** gfc_match_space (void) { locus old_loc; ! int c; if (gfc_current_form == FORM_FIXED) return MATCH_YES; old_loc = gfc_current_locus; ! c = gfc_next_char (); if (!gfc_is_whitespace (c)) { gfc_current_locus = old_loc; --- 249,262 ---- gfc_match_space (void) { locus old_loc; ! char c; if (gfc_current_form == FORM_FIXED) return MATCH_YES; old_loc = gfc_current_locus; ! c = gfc_next_ascii_char (); if (!gfc_is_whitespace (c)) { gfc_current_locus = old_loc; *************** match *** 251,257 **** gfc_match_eos (void) { locus old_loc; ! int flag, c; flag = 0; --- 277,284 ---- gfc_match_eos (void) { locus old_loc; ! int flag; ! char c; flag = 0; *************** gfc_match_eos (void) *** 260,272 **** old_loc = gfc_current_locus; gfc_gobble_whitespace (); ! c = gfc_next_char (); switch (c) { case '!': do { ! c = gfc_next_char (); } while (c != '\n'); --- 287,299 ---- old_loc = gfc_current_locus; gfc_gobble_whitespace (); ! c = gfc_next_ascii_char (); switch (c) { case '!': do { ! c = gfc_next_ascii_char (); } while (c != '\n'); *************** gfc_match_small_literal_int (int *value, *** 302,309 **** old_loc = gfc_current_locus; gfc_gobble_whitespace (); ! c = gfc_next_char (); if (cnt) *cnt = 0; --- 329,337 ---- old_loc = gfc_current_locus; + *value = -1; gfc_gobble_whitespace (); ! c = gfc_next_ascii_char (); if (cnt) *cnt = 0; *************** gfc_match_small_literal_int (int *value, *** 319,325 **** for (;;) { old_loc = gfc_current_locus; ! c = gfc_next_char (); if (!ISDIGIT (c)) break; --- 347,353 ---- for (;;) { old_loc = gfc_current_locus; ! c = gfc_next_ascii_char (); if (!ISDIGIT (c)) break; *************** match *** 488,499 **** gfc_match_name (char *buffer) { locus old_loc; ! int i, c; old_loc = gfc_current_locus; gfc_gobble_whitespace (); ! c = gfc_next_char (); if (!(ISALPHA (c) || (c == '_' && gfc_option.flag_allow_leading_underscore))) { if (gfc_error_flag_test() == 0 && c != '(') --- 516,528 ---- gfc_match_name (char *buffer) { locus old_loc; ! int i; ! char c; old_loc = gfc_current_locus; gfc_gobble_whitespace (); ! c = gfc_next_ascii_char (); if (!(ISALPHA (c) || (c == '_' && gfc_option.flag_allow_leading_underscore))) { if (gfc_error_flag_test() == 0 && c != '(') *************** gfc_match_name (char *buffer) *** 515,524 **** } old_loc = gfc_current_locus; ! c = gfc_next_char (); } while (ISALNUM (c) || c == '_' || (gfc_option.flag_dollar_ok && c == '$')); buffer[i] = '\0'; gfc_current_locus = old_loc; --- 544,560 ---- } old_loc = gfc_current_locus; ! c = gfc_next_ascii_char (); } while (ISALNUM (c) || c == '_' || (gfc_option.flag_dollar_ok && c == '$')); + if (c == '$' && !gfc_option.flag_dollar_ok) + { + gfc_error ("Invalid character '$' at %C. Use -fdollar-ok to allow it " + "as an extension"); + return MATCH_ERROR; + } + buffer[i] = '\0'; gfc_current_locus = old_loc; *************** gfc_match_name_C (char *buffer) *** 544,550 **** { locus old_loc; int i = 0; ! int c; old_loc = gfc_current_locus; gfc_gobble_whitespace (); --- 580,586 ---- { locus old_loc; int i = 0; ! gfc_char_t c; old_loc = gfc_current_locus; gfc_gobble_whitespace (); *************** gfc_match_name_C (char *buffer) *** 572,578 **** /* Continue to read valid variable name characters. */ do { ! buffer[i++] = c; /* C does not define a maximum length of variable names, to my knowledge, but the compiler typically places a limit on them. --- 608,616 ---- /* Continue to read valid variable name characters. */ do { ! gcc_assert (gfc_wide_fits_in_byte (c)); ! ! buffer[i++] = (unsigned char) c; /* C does not define a maximum length of variable names, to my knowledge, but the compiler typically places a limit on them. *************** gfc_match_name_C (char *buffer) *** 599,605 **** if (c == ' ') { gfc_gobble_whitespace (); ! c = gfc_peek_char (); if (c != '"' && c != '\'') { gfc_error ("Embedded space in NAME= specifier at %C"); --- 637,643 ---- if (c == ' ') { gfc_gobble_whitespace (); ! c = gfc_peek_ascii_char (); if (c != '"' && c != '\'') { gfc_error ("Embedded space in NAME= specifier at %C"); *************** match *** 672,681 **** gfc_match_intrinsic_op (gfc_intrinsic_op *result) { locus orig_loc = gfc_current_locus; ! int ch; gfc_gobble_whitespace (); ! ch = gfc_next_char (); switch (ch) { case '+': --- 710,719 ---- gfc_match_intrinsic_op (gfc_intrinsic_op *result) { locus orig_loc = gfc_current_locus; ! char ch; gfc_gobble_whitespace (); ! ch = gfc_next_ascii_char (); switch (ch) { case '+': *************** gfc_match_intrinsic_op (gfc_intrinsic_op *** 689,695 **** return MATCH_YES; case '=': ! if (gfc_next_char () == '=') { /* Matched "==". */ *result = INTRINSIC_EQ; --- 727,733 ---- return MATCH_YES; case '=': ! if (gfc_next_ascii_char () == '=') { /* Matched "==". */ *result = INTRINSIC_EQ; *************** gfc_match_intrinsic_op (gfc_intrinsic_op *** 698,707 **** break; case '<': ! if (gfc_peek_char () == '=') { /* Matched "<=". */ ! gfc_next_char (); *result = INTRINSIC_LE; return MATCH_YES; } --- 736,745 ---- break; case '<': ! if (gfc_peek_ascii_char () == '=') { /* Matched "<=". */ ! gfc_next_ascii_char (); *result = INTRINSIC_LE; return MATCH_YES; } *************** gfc_match_intrinsic_op (gfc_intrinsic_op *** 710,719 **** return MATCH_YES; case '>': ! if (gfc_peek_char () == '=') { /* Matched ">=". */ ! gfc_next_char (); *result = INTRINSIC_GE; return MATCH_YES; } --- 748,757 ---- return MATCH_YES; case '>': ! if (gfc_peek_ascii_char () == '=') { /* Matched ">=". */ ! gfc_next_ascii_char (); *result = INTRINSIC_GE; return MATCH_YES; } *************** gfc_match_intrinsic_op (gfc_intrinsic_op *** 722,731 **** return MATCH_YES; case '*': ! if (gfc_peek_char () == '*') { /* Matched "**". */ ! gfc_next_char (); *result = INTRINSIC_POWER; return MATCH_YES; } --- 760,769 ---- return MATCH_YES; case '*': ! if (gfc_peek_ascii_char () == '*') { /* Matched "**". */ ! gfc_next_ascii_char (); *result = INTRINSIC_POWER; return MATCH_YES; } *************** gfc_match_intrinsic_op (gfc_intrinsic_op *** 734,751 **** return MATCH_YES; case '/': ! ch = gfc_peek_char (); if (ch == '=') { /* Matched "/=". */ ! gfc_next_char (); *result = INTRINSIC_NE; return MATCH_YES; } else if (ch == '/') { /* Matched "//". */ ! gfc_next_char (); *result = INTRINSIC_CONCAT; return MATCH_YES; } --- 772,789 ---- return MATCH_YES; case '/': ! ch = gfc_peek_ascii_char (); if (ch == '=') { /* Matched "/=". */ ! gfc_next_ascii_char (); *result = INTRINSIC_NE; return MATCH_YES; } else if (ch == '/') { /* Matched "//". */ ! gfc_next_ascii_char (); *result = INTRINSIC_CONCAT; return MATCH_YES; } *************** gfc_match_intrinsic_op (gfc_intrinsic_op *** 754,766 **** return MATCH_YES; case '.': ! ch = gfc_next_char (); switch (ch) { case 'a': ! if (gfc_next_char () == 'n' ! && gfc_next_char () == 'd' ! && gfc_next_char () == '.') { /* Matched ".and.". */ *result = INTRINSIC_AND; --- 792,804 ---- return MATCH_YES; case '.': ! ch = gfc_next_ascii_char (); switch (ch) { case 'a': ! if (gfc_next_ascii_char () == 'n' ! && gfc_next_ascii_char () == 'd' ! && gfc_next_ascii_char () == '.') { /* Matched ".and.". */ *result = INTRINSIC_AND; *************** gfc_match_intrinsic_op (gfc_intrinsic_op *** 769,777 **** break; case 'e': ! if (gfc_next_char () == 'q') { ! ch = gfc_next_char (); if (ch == '.') { /* Matched ".eq.". */ --- 807,815 ---- break; case 'e': ! if (gfc_next_ascii_char () == 'q') { ! ch = gfc_next_ascii_char (); if (ch == '.') { /* Matched ".eq.". */ *************** gfc_match_intrinsic_op (gfc_intrinsic_op *** 780,786 **** } else if (ch == 'v') { ! if (gfc_next_char () == '.') { /* Matched ".eqv.". */ *result = INTRINSIC_EQV; --- 818,824 ---- } else if (ch == 'v') { ! if (gfc_next_ascii_char () == '.') { /* Matched ".eqv.". */ *result = INTRINSIC_EQV; *************** gfc_match_intrinsic_op (gfc_intrinsic_op *** 791,800 **** break; case 'g': ! ch = gfc_next_char (); if (ch == 'e') { ! if (gfc_next_char () == '.') { /* Matched ".ge.". */ *result = INTRINSIC_GE_OS; --- 829,838 ---- break; case 'g': ! ch = gfc_next_ascii_char (); if (ch == 'e') { ! if (gfc_next_ascii_char () == '.') { /* Matched ".ge.". */ *result = INTRINSIC_GE_OS; *************** gfc_match_intrinsic_op (gfc_intrinsic_op *** 803,809 **** } else if (ch == 't') { ! if (gfc_next_char () == '.') { /* Matched ".gt.". */ *result = INTRINSIC_GT_OS; --- 841,847 ---- } else if (ch == 't') { ! if (gfc_next_ascii_char () == '.') { /* Matched ".gt.". */ *result = INTRINSIC_GT_OS; *************** gfc_match_intrinsic_op (gfc_intrinsic_op *** 813,822 **** break; case 'l': ! ch = gfc_next_char (); if (ch == 'e') { ! if (gfc_next_char () == '.') { /* Matched ".le.". */ *result = INTRINSIC_LE_OS; --- 851,860 ---- break; case 'l': ! ch = gfc_next_ascii_char (); if (ch == 'e') { ! if (gfc_next_ascii_char () == '.') { /* Matched ".le.". */ *result = INTRINSIC_LE_OS; *************** gfc_match_intrinsic_op (gfc_intrinsic_op *** 825,831 **** } else if (ch == 't') { ! if (gfc_next_char () == '.') { /* Matched ".lt.". */ *result = INTRINSIC_LT_OS; --- 863,869 ---- } else if (ch == 't') { ! if (gfc_next_ascii_char () == '.') { /* Matched ".lt.". */ *result = INTRINSIC_LT_OS; *************** gfc_match_intrinsic_op (gfc_intrinsic_op *** 835,844 **** break; case 'n': ! ch = gfc_next_char (); if (ch == 'e') { ! ch = gfc_next_char (); if (ch == '.') { /* Matched ".ne.". */ --- 873,882 ---- break; case 'n': ! ch = gfc_next_ascii_char (); if (ch == 'e') { ! ch = gfc_next_ascii_char (); if (ch == '.') { /* Matched ".ne.". */ *************** gfc_match_intrinsic_op (gfc_intrinsic_op *** 847,854 **** } else if (ch == 'q') { ! if (gfc_next_char () == 'v' ! && gfc_next_char () == '.') { /* Matched ".neqv.". */ *result = INTRINSIC_NEQV; --- 885,892 ---- } else if (ch == 'q') { ! if (gfc_next_ascii_char () == 'v' ! && gfc_next_ascii_char () == '.') { /* Matched ".neqv.". */ *result = INTRINSIC_NEQV; *************** gfc_match_intrinsic_op (gfc_intrinsic_op *** 858,865 **** } else if (ch == 'o') { ! if (gfc_next_char () == 't' ! && gfc_next_char () == '.') { /* Matched ".not.". */ *result = INTRINSIC_NOT; --- 896,903 ---- } else if (ch == 'o') { ! if (gfc_next_ascii_char () == 't' ! && gfc_next_ascii_char () == '.') { /* Matched ".not.". */ *result = INTRINSIC_NOT; *************** gfc_match_intrinsic_op (gfc_intrinsic_op *** 869,876 **** break; case 'o': ! if (gfc_next_char () == 'r' ! && gfc_next_char () == '.') { /* Matched ".or.". */ *result = INTRINSIC_OR; --- 907,914 ---- break; case 'o': ! if (gfc_next_ascii_char () == 'r' ! && gfc_next_ascii_char () == '.') { /* Matched ".or.". */ *result = INTRINSIC_OR; *************** gfc_match_char (char c) *** 1000,1006 **** where = gfc_current_locus; gfc_gobble_whitespace (); ! if (gfc_next_char () == c) return MATCH_YES; gfc_current_locus = where; --- 1038,1044 ---- where = gfc_current_locus; gfc_gobble_whitespace (); ! if (gfc_next_ascii_char () == c) return MATCH_YES; gfc_current_locus = where; *************** loop: *** 1150,1156 **** } default: ! if (c == gfc_next_char ()) goto loop; break; } --- 1188,1199 ---- } default: ! ! /* gfc_next_ascii_char converts characters to lower-case, so we shouldn't ! expect an upper case character here! */ ! gcc_assert (TOLOWER (c) == c); ! ! if (c == gfc_next_ascii_char ()) goto loop; break; } *************** not_yes: *** 1186,1192 **** case 'e': case 'v': vp = va_arg (argp, void **); ! gfc_free_expr (*vp); *vp = NULL; break; } --- 1229,1235 ---- case 'e': case 'v': vp = va_arg (argp, void **); ! gfc_free_expr ((struct gfc_expr *)*vp); *vp = NULL; break; } *************** gfc_match_assignment (void) *** 1250,1264 **** return MATCH_NO; } - if (lvalue->symtree->n.sym->attr.protected - && lvalue->symtree->n.sym->attr.use_assoc) - { - gfc_current_locus = old_loc; - gfc_free_expr (lvalue); - gfc_error ("Setting value of PROTECTED variable at %C"); - return MATCH_ERROR; - } - rvalue = NULL; m = gfc_match (" %e%t", &rvalue); if (m != MATCH_YES) --- 1293,1298 ---- *************** gfc_match_pointer_assignment (void) *** 1293,1298 **** --- 1327,1333 ---- old_loc = gfc_current_locus; lvalue = rvalue = NULL; + gfc_matching_procptr_assignment = 0; m = gfc_match (" %v =>", &lvalue); if (m != MATCH_YES) *************** gfc_match_pointer_assignment (void) *** 1301,1318 **** goto cleanup; } m = gfc_match (" %e%t", &rvalue); if (m != MATCH_YES) goto cleanup; - if (lvalue->symtree->n.sym->attr.protected - && lvalue->symtree->n.sym->attr.use_assoc) - { - gfc_error ("Assigning to a PROTECTED pointer at %C"); - m = MATCH_ERROR; - goto cleanup; - } - new_st.op = EXEC_POINTER_ASSIGN; new_st.expr = lvalue; new_st.expr2 = rvalue; --- 1336,1349 ---- goto cleanup; } + if (lvalue->symtree->n.sym->attr.proc_pointer) + gfc_matching_procptr_assignment = 1; + m = gfc_match (" %e%t", &rvalue); + gfc_matching_procptr_assignment = 0; if (m != MATCH_YES) goto cleanup; new_st.op = EXEC_POINTER_ASSIGN; new_st.expr = lvalue; new_st.expr2 = rvalue; *************** gfc_match_if (gfc_statement *if_type) *** 1526,1531 **** --- 1557,1563 ---- match ("return", gfc_match_return, ST_RETURN) match ("rewind", gfc_match_rewind, ST_REWIND) match ("stop", gfc_match_stop, ST_STOP) + match ("wait", gfc_match_wait, ST_WAIT) match ("where", match_simple_where, ST_WHERE) match ("write", gfc_match_write, ST_WRITE) *************** gfc_match_do (void) *** 1711,1716 **** --- 1743,1753 ---- if (gfc_match_char (',') != MATCH_YES && gfc_match ("% ") != MATCH_YES) return MATCH_NO; + /* Check for balanced parens. */ + + if (gfc_match_parens () == MATCH_ERROR) + return MATCH_ERROR; + /* See if we have a DO WHILE. */ if (gfc_match (" while ( %e )%t", &iter.end) == MATCH_YES) { *************** gfc_match_return (void) *** 2406,2412 **** gfc_expr *e; match m; gfc_compile_state s; - int c; e = NULL; if (gfc_match_eos () == MATCH_YES) --- 2443,2448 ---- *************** gfc_match_return (void) *** 2425,2431 **** RETURN keyword: return+1 return(1) */ ! c = gfc_peek_char (); if (ISALPHA (c) || ISDIGIT (c)) return MATCH_NO; } --- 2461,2467 ---- RETURN keyword: return+1 return(1) */ ! char c = gfc_peek_ascii_char (); if (ISALPHA (c) || ISDIGIT (c)) return MATCH_NO; } *************** done: *** 2456,2461 **** --- 2492,2540 ---- } + /* Match the call of a type-bound procedure, if CALL%var has already been + matched and var found to be a derived-type variable. */ + + static match + match_typebound_call (gfc_symtree* varst) + { + gfc_symbol* var; + gfc_expr* base; + match m; + + var = varst->n.sym; + + base = gfc_get_expr (); + base->expr_type = EXPR_VARIABLE; + base->symtree = varst; + base->where = gfc_current_locus; + gfc_set_sym_referenced (varst->n.sym); + + m = gfc_match_varspec (base, 0, true); + if (m == MATCH_NO) + gfc_error ("Expected component reference at %C"); + if (m != MATCH_YES) + return MATCH_ERROR; + + if (gfc_match_eos () != MATCH_YES) + { + gfc_error ("Junk after CALL at %C"); + return MATCH_ERROR; + } + + if (base->expr_type != EXPR_COMPCALL) + { + gfc_error ("Expected type-bound procedure reference at %C"); + return MATCH_ERROR; + } + + new_st.op = EXEC_COMPCALL; + new_st.expr = base; + + return MATCH_YES; + } + + /* Match a CALL statement. The tricky part here are possible alternate return specifiers. We handle these by having all "subroutines" actually return an integer via a register that gives *************** gfc_match_call (void) *** 2488,2493 **** --- 2567,2577 ---- sym = st->n.sym; + /* If this is a variable of derived-type, it probably starts a type-bound + procedure call. */ + if (sym->attr.flavor != FL_PROCEDURE && sym->ts.type == BT_DERIVED) + return match_typebound_call (st); + /* If it does not seem to be callable (include functions so that the right association is made. They are thrown out in resolution.) ... */ *************** gfc_match_common (void) *** 2863,2874 **** gfc_gobble_whitespace (); if (gfc_match_eos () == MATCH_YES) goto done; ! if (gfc_peek_char () == '/') break; if (gfc_match_char (',') != MATCH_YES) goto syntax; gfc_gobble_whitespace (); ! if (gfc_peek_char () == '/') break; } } --- 2947,2958 ---- gfc_gobble_whitespace (); if (gfc_match_eos () == MATCH_YES) goto done; ! if (gfc_peek_ascii_char () == '/') break; if (gfc_match_char (',') != MATCH_YES) goto syntax; gfc_gobble_whitespace (); ! if (gfc_peek_ascii_char () == '/') break; } } *************** match_forall_iterator (gfc_forall_iterat *** 3732,3738 **** match m; where = gfc_current_locus; ! iter = gfc_getmem (sizeof (gfc_forall_iterator)); m = gfc_match_expr (&iter->var); if (m != MATCH_YES) --- 3816,3822 ---- match m; where = gfc_current_locus; ! iter = XCNEW (gfc_forall_iterator); m = gfc_match_expr (&iter->var); if (m != MATCH_YES) *************** cleanup: *** 3792,3798 **** static match match_forall_header (gfc_forall_iterator **phead, gfc_expr **mask) { ! gfc_forall_iterator *head, *tail, *new; gfc_expr *msk; match m; --- 3876,3882 ---- static match match_forall_header (gfc_forall_iterator **phead, gfc_expr **mask) { ! gfc_forall_iterator *head, *tail, *new_iter; gfc_expr *msk; match m; *************** match_forall_header (gfc_forall_iterator *** 3804,3830 **** if (gfc_match_char ('(') != MATCH_YES) return MATCH_NO; ! m = match_forall_iterator (&new); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) goto syntax; ! head = tail = new; for (;;) { if (gfc_match_char (',') != MATCH_YES) break; ! m = match_forall_iterator (&new); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_YES) { ! tail->next = new; ! tail = new; continue; } --- 3888,3914 ---- if (gfc_match_char ('(') != MATCH_YES) return MATCH_NO; ! m = match_forall_iterator (&new_iter); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) goto syntax; ! head = tail = new_iter; for (;;) { if (gfc_match_char (',') != MATCH_YES) break; ! m = match_forall_iterator (&new_iter); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_YES) { ! tail->next = new_iter; ! tail = new_iter; continue; } diff -Nrcpad gcc-4.3.3/gcc/fortran/match.h gcc-4.4.0/gcc/fortran/match.h *** gcc-4.3.3/gcc/fortran/match.h Thu Jan 1 17:42:00 2009 --- gcc-4.4.0/gcc/fortran/match.h Fri Oct 31 15:56:21 2008 *************** *** 1,5 **** /* All matcher functions. ! Copyright (C) 2003, 2005, 2007 Free Software Foundation, Inc. Contributed by Steven Bosscher --- 1,5 ---- /* All matcher functions. ! Copyright (C) 2003, 2005, 2007, 2008 Free Software Foundation, Inc. Contributed by Steven Bosscher *************** extern gfc_symbol *gfc_new_block; *** 33,44 **** separate. */ extern gfc_st_label *gfc_statement_label; /****************** All gfc_match* routines *****************/ /* match.c. */ /* Generic match subroutines. */ ! match gfc_match_special_char (int *); match gfc_match_space (void); match gfc_match_eos (void); match gfc_match_small_literal_int (int *, int *); --- 33,50 ---- separate. */ extern gfc_st_label *gfc_statement_label; + extern int gfc_matching_procptr_assignment; + extern bool gfc_matching_prefix; + + /* Default access specifier while matching procedure bindings. */ + extern gfc_access gfc_typebound_default_access; + /****************** All gfc_match* routines *****************/ /* match.c. */ /* Generic match subroutines. */ ! match gfc_match_special_char (gfc_char_t *); match gfc_match_space (void); match gfc_match_eos (void); match gfc_match_small_literal_int (int *, int *); *************** match gfc_match_omp_parallel_sections (v *** 119,124 **** --- 125,132 ---- match gfc_match_omp_parallel_workshare (void); match gfc_match_omp_sections (void); match gfc_match_omp_single (void); + match gfc_match_omp_task (void); + match gfc_match_omp_taskwait (void); match gfc_match_omp_threadprivate (void); match gfc_match_omp_workshare (void); match gfc_match_omp_end_nowait (void); *************** match gfc_match_end (gfc_statement *); *** 136,150 **** match gfc_match_data_decl (void); match gfc_match_formal_arglist (gfc_symbol *, int, int); match gfc_match_procedure (void); match gfc_match_function_decl (void); match gfc_match_entry (void); match gfc_match_subroutine (void); match gfc_match_derived_decl (void); match gfc_match_implicit_none (void); match gfc_match_implicit (void); ! void gfc_set_constant_character_len (int, gfc_expr *, bool); /* Matchers for attribute declarations. */ match gfc_match_allocatable (void); --- 144,160 ---- match gfc_match_data_decl (void); match gfc_match_formal_arglist (gfc_symbol *, int, int); match gfc_match_procedure (void); + match gfc_match_generic (void); match gfc_match_function_decl (void); match gfc_match_entry (void); match gfc_match_subroutine (void); match gfc_match_derived_decl (void); + match gfc_match_final_decl (void); match gfc_match_implicit_none (void); match gfc_match_implicit (void); ! void gfc_set_constant_character_len (int, gfc_expr *, int); /* Matchers for attribute declarations. */ match gfc_match_allocatable (void); *************** match gfc_match_volatile (void); *** 170,186 **** /* Fortran 2003 c interop. TODO: some of these should be moved to another file rather than decl.c */ void set_com_block_bind_c (gfc_common_head *, int); ! try set_binding_label (char *, const char *, int); ! try set_verify_bind_c_sym (gfc_symbol *, int); ! try set_verify_bind_c_com_block (gfc_common_head *, int); ! try get_bind_c_idents (void); match gfc_match_bind_c_stmt (void); match gfc_match_suffix (gfc_symbol *, gfc_symbol **); match gfc_match_bind_c (gfc_symbol *, bool); ! match gfc_get_type_attr_spec (symbol_attribute *); /* primary.c. */ ! match gfc_match_structure_constructor (gfc_symbol *, gfc_expr **); match gfc_match_variable (gfc_expr **, int); match gfc_match_equiv_variable (gfc_expr **); match gfc_match_actual_arglist (int, gfc_actual_arglist **); --- 180,196 ---- /* Fortran 2003 c interop. TODO: some of these should be moved to another file rather than decl.c */ void set_com_block_bind_c (gfc_common_head *, int); ! gfc_try set_binding_label (char *, const char *, int); ! gfc_try set_verify_bind_c_sym (gfc_symbol *, int); ! gfc_try set_verify_bind_c_com_block (gfc_common_head *, int); ! gfc_try get_bind_c_idents (void); match gfc_match_bind_c_stmt (void); match gfc_match_suffix (gfc_symbol *, gfc_symbol **); match gfc_match_bind_c (gfc_symbol *, bool); ! match gfc_get_type_attr_spec (symbol_attribute *, char*); /* primary.c. */ ! match gfc_match_structure_constructor (gfc_symbol *, gfc_expr **, bool); match gfc_match_variable (gfc_expr **, int); match gfc_match_equiv_variable (gfc_expr **); match gfc_match_actual_arglist (int, gfc_actual_arglist **); *************** match gfc_match_literal_constant (gfc_ex *** 189,195 **** /* expr.c -- FIXME: this one should be eliminated by moving the matcher to matchexp.c and a call to a new function in expr.c that only makes sure the init expr. is valid. */ ! try gfc_reduce_init_expr (gfc_expr *expr); match gfc_match_init_expr (gfc_expr **); /* array.c. */ --- 199,205 ---- /* expr.c -- FIXME: this one should be eliminated by moving the matcher to matchexp.c and a call to a new function in expr.c that only makes sure the init expr. is valid. */ ! gfc_try gfc_reduce_init_expr (gfc_expr *expr); match gfc_match_init_expr (gfc_expr **); /* array.c. */ *************** match gfc_match_rewind (void); *** 213,218 **** --- 223,229 ---- match gfc_match_flush (void); match gfc_match_inquire (void); match gfc_match_read (void); + match gfc_match_wait (void); match gfc_match_write (void); match gfc_match_print (void); diff -Nrcpad gcc-4.3.3/gcc/fortran/matchexp.c gcc-4.4.0/gcc/fortran/matchexp.c *** gcc-4.3.3/gcc/fortran/matchexp.c Sun Dec 23 17:34:45 2007 --- gcc-4.4.0/gcc/fortran/matchexp.c Mon Jul 21 19:17:08 2008 *************** *** 1,5 **** /* Expression parser. ! Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Expression parser. ! Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Andy Vaught *************** gfc_get_parentheses (gfc_expr *e) *** 130,148 **** { gfc_expr *e2; - /* This is a temporary fix, awaiting the patch for various - other character problems. The resolution and translation - of substrings and concatenations are so kludged up that - putting parentheses around them breaks everything. */ - if (e->ts.type == BT_CHARACTER && e->ref) - return e; - e2 = gfc_get_expr(); e2->expr_type = EXPR_OP; e2->ts = e->ts; e2->rank = e->rank; e2->where = e->where; ! e2->value.op.operator = INTRINSIC_PARENTHESES; e2->value.op.op1 = e; e2->value.op.op2 = NULL; return e2; --- 130,141 ---- { gfc_expr *e2; e2 = gfc_get_expr(); e2->expr_type = EXPR_OP; e2->ts = e->ts; e2->rank = e->rank; e2->where = e->where; ! e2->value.op.op = INTRINSIC_PARENTHESES; e2->value.op.op1 = e; e2->value.op.op2 = NULL; return e2; *************** syntax: *** 208,227 **** /* Build an operator expression node. */ static gfc_expr * ! build_node (gfc_intrinsic_op operator, locus *where, gfc_expr *op1, gfc_expr *op2) { ! gfc_expr *new; ! new = gfc_get_expr (); ! new->expr_type = EXPR_OP; ! new->value.op.operator = operator; ! new->where = *where; ! new->value.op.op1 = op1; ! new->value.op.op2 = op2; ! return new; } --- 201,220 ---- /* Build an operator expression node. */ static gfc_expr * ! build_node (gfc_intrinsic_op op, locus *where, gfc_expr *op1, gfc_expr *op2) { ! gfc_expr *new_expr; ! new_expr = gfc_get_expr (); ! new_expr->expr_type = EXPR_OP; ! new_expr->value.op.op = op; ! new_expr->where = *where; ! new_expr->value.op.op1 = op1; ! new_expr->value.op.op2 = op2; ! return new_expr; } *************** match_level_1 (gfc_expr **result) *** 261,267 **** /* As a GNU extension we support an expanded level-2 expression syntax. Via this extension we support (arbitrary) nesting of unary plus and minus operations following unary and binary operators, such as **. ! The grammar of section 7.1.1.3 is effectively rewitten as: R704 mult-operand is level-1-expr [ power-op ext-mult-operand ] R704' ext-mult-operand is add-op ext-mult-operand --- 254,260 ---- /* As a GNU extension we support an expanded level-2 expression syntax. Via this extension we support (arbitrary) nesting of unary plus and minus operations following unary and binary operators, such as **. ! The grammar of section 7.1.1.3 is effectively rewritten as: R704 mult-operand is level-1-expr [ power-op ext-mult-operand ] R704' ext-mult-operand is add-op ext-mult-operand diff -Nrcpad gcc-4.3.3/gcc/fortran/mathbuiltins.def gcc-4.4.0/gcc/fortran/mathbuiltins.def *** gcc-4.3.3/gcc/fortran/mathbuiltins.def Sun Oct 7 21:36:09 2007 --- gcc-4.4.0/gcc/fortran/mathbuiltins.def Mon Mar 3 23:46:20 2008 *************** *** 6,16 **** Use DEFINE_MATH_BUILTIN_C if the complex versions of the builtin are also available. */ DEFINE_MATH_BUILTIN_C (ACOS, "acos", 0) ! DEFINE_MATH_BUILTIN (ACOSH, "acosh", 0) DEFINE_MATH_BUILTIN_C (ASIN, "asin", 0) ! DEFINE_MATH_BUILTIN (ASINH, "asinh", 0) DEFINE_MATH_BUILTIN_C (ATAN, "atan", 0) ! DEFINE_MATH_BUILTIN (ATANH, "atanh", 0) DEFINE_MATH_BUILTIN (ATAN2, "atan2", 1) DEFINE_MATH_BUILTIN_C (COS, "cos", 0) DEFINE_MATH_BUILTIN_C (COSH, "cosh", 0) --- 6,16 ---- Use DEFINE_MATH_BUILTIN_C if the complex versions of the builtin are also available. */ DEFINE_MATH_BUILTIN_C (ACOS, "acos", 0) ! DEFINE_MATH_BUILTIN_C (ACOSH, "acosh", 0) DEFINE_MATH_BUILTIN_C (ASIN, "asin", 0) ! DEFINE_MATH_BUILTIN_C (ASINH, "asinh", 0) DEFINE_MATH_BUILTIN_C (ATAN, "atan", 0) ! DEFINE_MATH_BUILTIN_C (ATANH, "atanh", 0) DEFINE_MATH_BUILTIN (ATAN2, "atan2", 1) DEFINE_MATH_BUILTIN_C (COS, "cos", 0) DEFINE_MATH_BUILTIN_C (COSH, "cosh", 0) *************** DEFINE_MATH_BUILTIN (ERF, "erf", *** 32,34 **** --- 32,35 ---- DEFINE_MATH_BUILTIN (ERFC, "erfc", 0) DEFINE_MATH_BUILTIN (GAMMA, "tgamma", 0) DEFINE_MATH_BUILTIN (LGAMMA,"lgamma", 0) + DEFINE_MATH_BUILTIN (HYPOT, "hypot", 1) diff -Nrcpad gcc-4.3.3/gcc/fortran/misc.c gcc-4.4.0/gcc/fortran/misc.c *** gcc-4.3.3/gcc/fortran/misc.c Thu Jan 17 07:19:04 2008 --- gcc-4.4.0/gcc/fortran/misc.c Sat May 3 20:37:48 2008 *************** *** 1,5 **** /* Miscellaneous stuff that doesn't fit anywhere else. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Miscellaneous stuff that doesn't fit anywhere else. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Andy Vaught *************** gfc_clear_ts (gfc_typespec *ts) *** 77,82 **** --- 77,83 ---- ts->derived = NULL; ts->kind = 0; ts->cl = NULL; + ts->interface = NULL; /* flag that says if the type is C interoperable */ ts->is_c_interop = 0; /* says what f90 type the C kind interops with */ diff -Nrcpad gcc-4.3.3/gcc/fortran/module.c gcc-4.4.0/gcc/fortran/module.c *** gcc-4.3.3/gcc/fortran/module.c Sat Jan 17 09:28:50 2009 --- gcc-4.4.0/gcc/fortran/module.c Fri Feb 27 07:45:47 2009 *************** *** 1,6 **** /* Handle modules, which amounts to loading and saving symbols and their attendant structures. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,6 ---- /* Handle modules, which amounts to loading and saving symbols and their attendant structures. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught *************** You should have received a copy of the G *** 20,26 **** along with GCC; see the file COPYING3. If not see . */ ! /* The syntax of gfortran modules resembles that of lisp lists, ie a sequence of atoms, which can be left or right parenthesis, names, integers or strings. Parenthesis are always matched which allows us to skip over sections at high speed without having to know --- 20,26 ---- along with GCC; see the file COPYING3. If not see . */ ! /* The syntax of gfortran modules resembles that of lisp lists, i.e. a sequence of atoms, which can be left or right parenthesis, names, integers or strings. Parenthesis are always matched which allows us to skip over sections at high speed without having to know *************** along with GCC; see the file COPYING3. *** 75,80 **** --- 75,84 ---- #define MODULE_EXTENSION ".mod" + /* Don't put any single quote (') in MOD_VERSION, + if yout want it to be recognized. */ + #define MOD_VERSION "0" + /* Structure that describes a position within a module file. */ *************** typedef struct *** 91,96 **** --- 95,101 ---- int id; const char *name; int value; + int standard; } intmod_sym; *************** typedef struct pointer_info *** 158,179 **** } pointer_info; ! #define gfc_get_pointer_info() gfc_getmem(sizeof(pointer_info)) ! ! ! /* Lists of rename info for the USE statement. */ ! ! typedef struct gfc_use_rename ! { ! char local_name[GFC_MAX_SYMBOL_LEN + 1], use_name[GFC_MAX_SYMBOL_LEN + 1]; ! struct gfc_use_rename *next; ! int found; ! gfc_intrinsic_op operator; ! locus where; ! } ! gfc_use_rename; - #define gfc_get_use_rename() gfc_getmem(sizeof(gfc_use_rename)) /* Local variables */ --- 163,170 ---- } pointer_info; ! #define gfc_get_pointer_info() XCNEW (pointer_info) /* Local variables */ *************** static int symbol_number; /* Counter for *** 201,206 **** --- 192,199 ---- /* Tells mio_expr_ref to make symbols for unused equivalence members. */ static bool in_load_equiv; + static locus use_locus; + /*****************************************************************/ *************** associate_integer_pointer (pointer_info *** 445,451 **** either store the pointer from an already-known value or create a fixup structure in order to store things later. Returns zero if the reference has been actually stored, or nonzero if the reference ! must be fixed later (ie associate_integer_pointer must be called sometime later. Returns the pointer_info structure. */ static pointer_info * --- 438,444 ---- either store the pointer from an already-known value or create a fixup structure in order to store things later. Returns zero if the reference has been actually stored, or nonzero if the reference ! must be fixed later (i.e., associate_integer_pointer must be called sometime later. Returns the pointer_info structure. */ static pointer_info * *************** add_fixup (int integer, void *gp) *** 459,475 **** if (p->integer == 0 || p->u.pointer != NULL) { ! cp = gp; ! *cp = p->u.pointer; } else { ! f = gfc_getmem (sizeof (fixup_t)); f->next = p->fixup; p->fixup = f; ! f->pointer = gp; } return p; --- 452,468 ---- if (p->integer == 0 || p->u.pointer != NULL) { ! cp = (char **) gp; ! *cp = (char *) p->u.pointer; } else { ! f = XCNEW (fixup_t); f->next = p->fixup; p->fixup = f; ! f->pointer = (void **) gp; } return p; *************** match *** 501,509 **** gfc_match_use (void) { char name[GFC_MAX_SYMBOL_LEN + 1], module_nature[GFC_MAX_SYMBOL_LEN + 1]; ! gfc_use_rename *tail = NULL, *new; interface_type type, type2; ! gfc_intrinsic_op operator; match m; specified_int = false; --- 494,502 ---- gfc_match_use (void) { char name[GFC_MAX_SYMBOL_LEN + 1], module_nature[GFC_MAX_SYMBOL_LEN + 1]; ! gfc_use_rename *tail = NULL, *new_use; interface_type type, type2; ! gfc_intrinsic_op op; match m; specified_int = false; *************** gfc_match_use (void) *** 559,564 **** --- 552,559 ---- } } + use_locus = gfc_current_locus; + m = gfc_match_name (module_name); if (m != MATCH_YES) return m; *************** gfc_match_use (void) *** 580,599 **** for (;;) { /* Get a new rename struct and add it to the rename list. */ ! new = gfc_get_use_rename (); ! new->where = gfc_current_locus; ! new->found = 0; if (gfc_rename_list == NULL) ! gfc_rename_list = new; else ! tail->next = new; ! tail = new; /* See what kind of interface we're dealing with. Assume it is not an operator. */ ! new->operator = INTRINSIC_NONE; ! if (gfc_match_generic_spec (&type, name, &operator) == MATCH_ERROR) goto cleanup; switch (type) --- 575,594 ---- for (;;) { /* Get a new rename struct and add it to the rename list. */ ! new_use = gfc_get_use_rename (); ! new_use->where = gfc_current_locus; ! new_use->found = 0; if (gfc_rename_list == NULL) ! gfc_rename_list = new_use; else ! tail->next = new_use; ! tail = new_use; /* See what kind of interface we're dealing with. Assume it is not an operator. */ ! new_use->op = INTRINSIC_NONE; ! if (gfc_match_generic_spec (&type, name, &op) == MATCH_ERROR) goto cleanup; switch (type) *************** gfc_match_use (void) *** 613,628 **** goto cleanup; if (type == INTERFACE_USER_OP) ! new->operator = INTRINSIC_USER; if (only_flag) { if (m != MATCH_YES) ! strcpy (new->use_name, name); else { ! strcpy (new->local_name, name); ! m = gfc_match_generic_spec (&type2, new->use_name, &operator); if (type != type2) goto syntax; if (m == MATCH_NO) --- 608,623 ---- goto cleanup; if (type == INTERFACE_USER_OP) ! new_use->op = INTRINSIC_USER; if (only_flag) { if (m != MATCH_YES) ! strcpy (new_use->use_name, name); else { ! strcpy (new_use->local_name, name); ! m = gfc_match_generic_spec (&type2, new_use->use_name, &op); if (type != type2) goto syntax; if (m == MATCH_NO) *************** gfc_match_use (void) *** 635,643 **** { if (m != MATCH_YES) goto syntax; ! strcpy (new->local_name, name); ! m = gfc_match_generic_spec (&type2, new->use_name, &operator); if (type != type2) goto syntax; if (m == MATCH_NO) --- 630,638 ---- { if (m != MATCH_YES) goto syntax; ! strcpy (new_use->local_name, name); ! m = gfc_match_generic_spec (&type2, new_use->use_name, &op); if (type != type2) goto syntax; if (m == MATCH_NO) *************** gfc_match_use (void) *** 646,653 **** goto cleanup; } ! if (strcmp (new->use_name, module_name) == 0 ! || strcmp (new->local_name, module_name) == 0) { gfc_error ("The name '%s' at %C has already been used as " "an external module name.", module_name); --- 641,648 ---- goto cleanup; } ! if (strcmp (new_use->use_name, module_name) == 0 ! || strcmp (new_use->local_name, module_name) == 0) { gfc_error ("The name '%s' at %C has already been used as " "an external module name.", module_name); *************** gfc_match_use (void) *** 656,662 **** break; case INTERFACE_INTRINSIC_OP: ! new->operator = operator; break; default: --- 651,657 ---- break; case INTERFACE_INTRINSIC_OP: ! new_use->op = op; break; default: *************** find_use_name_n (const char *name, int * *** 697,704 **** for (u = gfc_rename_list; u; u = u->next) { if (strcmp (u->use_name, name) != 0 ! || (u->operator == INTRINSIC_USER && !interface) ! || (u->operator != INTRINSIC_USER && interface)) continue; if (++i == *inst) break; --- 692,699 ---- for (u = gfc_rename_list; u; u = u->next) { if (strcmp (u->use_name, name) != 0 ! || (u->op == INTRINSIC_USER && !interface) ! || (u->op != INTRINSIC_USER && interface)) continue; if (++i == *inst) break; *************** number_use_names (const char *name, bool *** 745,756 **** /* Try to find the operator in the current list. */ static gfc_use_rename * ! find_use_operator (gfc_intrinsic_op operator) { gfc_use_rename *u; for (u = gfc_rename_list; u; u = u->next) ! if (u->operator == operator) return u; return NULL; --- 740,751 ---- /* Try to find the operator in the current list. */ static gfc_use_rename * ! find_use_operator (gfc_intrinsic_op op) { gfc_use_rename *u; for (u = gfc_rename_list; u; u = u->next) ! if (u->op == op) return u; return NULL; *************** add_true_name (gfc_symbol *sym) *** 838,844 **** { true_name *t; ! t = gfc_getmem (sizeof (true_name)); t->sym = sym; gfc_insert_bbt (&true_name_root, t, compare_true_names); --- 833,839 ---- { true_name *t; ! t = XCNEW (true_name); t->sym = sym; gfc_insert_bbt (&true_name_root, t, compare_true_names); *************** parse_string (void) *** 1027,1033 **** set_module_locus (&start); ! atom_string = p = gfc_getmem (len + 1); for (; len > 0; len--) { --- 1022,1028 ---- set_module_locus (&start); ! atom_string = p = XCNEWVEC (char, len + 1); for (; len > 0; len--) { *************** write_atom (atom_type atom, const void * *** 1323,1329 **** { case ATOM_STRING: case ATOM_NAME: ! p = v; break; case ATOM_LPAREN: --- 1318,1324 ---- { case ATOM_STRING: case ATOM_NAME: ! p = (const char *) v; break; case ATOM_LPAREN: *************** mio_allocated_string (const char *s) *** 1474,1479 **** --- 1469,1598 ---- } + /* Functions for quoting and unquoting strings. */ + + static char * + quote_string (const gfc_char_t *s, const size_t slength) + { + const gfc_char_t *p; + char *res, *q; + size_t len = 0, i; + + /* Calculate the length we'll need: a backslash takes two ("\\"), + non-printable characters take 10 ("\Uxxxxxxxx") and others take 1. */ + for (p = s, i = 0; i < slength; p++, i++) + { + if (*p == '\\') + len += 2; + else if (!gfc_wide_is_printable (*p)) + len += 10; + else + len++; + } + + q = res = XCNEWVEC (char, len + 1); + for (p = s, i = 0; i < slength; p++, i++) + { + if (*p == '\\') + *q++ = '\\', *q++ = '\\'; + else if (!gfc_wide_is_printable (*p)) + { + sprintf (q, "\\U%08" HOST_WIDE_INT_PRINT "x", + (unsigned HOST_WIDE_INT) *p); + q += 10; + } + else + *q++ = (unsigned char) *p; + } + + res[len] = '\0'; + return res; + } + + static gfc_char_t * + unquote_string (const char *s) + { + size_t len, i; + const char *p; + gfc_char_t *res; + + for (p = s, len = 0; *p; p++, len++) + { + if (*p != '\\') + continue; + + if (p[1] == '\\') + p++; + else if (p[1] == 'U') + p += 9; /* That is a "\U????????". */ + else + gfc_internal_error ("unquote_string(): got bad string"); + } + + res = gfc_get_wide_string (len + 1); + for (i = 0, p = s; i < len; i++, p++) + { + gcc_assert (*p); + + if (*p != '\\') + res[i] = (unsigned char) *p; + else if (p[1] == '\\') + { + res[i] = (unsigned char) '\\'; + p++; + } + else + { + /* We read the 8-digits hexadecimal constant that follows. */ + int j; + unsigned n; + gfc_char_t c = 0; + + gcc_assert (p[1] == 'U'); + for (j = 0; j < 8; j++) + { + c = c << 4; + gcc_assert (sscanf (&p[j+2], "%01x", &n) == 1); + c += n; + } + + res[i] = c; + p += 9; + } + } + + res[len] = '\0'; + return res; + } + + + /* Read or write a character pointer that points to a wide string on the + heap, performing quoting/unquoting of nonprintable characters using the + form \U???????? (where each ? is a hexadecimal digit). + Length is the length of the string, only known and used in output mode. */ + + static const gfc_char_t * + mio_allocated_wide_string (const gfc_char_t *s, const size_t length) + { + if (iomode == IO_OUTPUT) + { + char *quoted = quote_string (s, length); + write_atom (ATOM_STRING, quoted); + gfc_free (quoted); + return s; + } + else + { + gfc_char_t *unquoted; + + require_atom (ATOM_STRING); + unquoted = unquote_string (atom_string); + gfc_free (atom_string); + return unquoted; + } + } + + /* Read or write a string that is in static memory. */ static void *************** typedef enum *** 1523,1529 **** AB_ELEMENTAL, AB_PURE, AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT, AB_CRAY_POINTER, AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP, AB_POINTER_COMP, AB_PRIVATE_COMP, AB_VALUE, AB_VOLATILE, AB_PROTECTED, ! AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP } ab_attribute; --- 1642,1649 ---- AB_ELEMENTAL, AB_PURE, AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT, AB_CRAY_POINTER, AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP, AB_POINTER_COMP, AB_PRIVATE_COMP, AB_VALUE, AB_VOLATILE, AB_PROTECTED, ! AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP, ! AB_EXTENSION, AB_PROCEDURE, AB_PROC_POINTER } ab_attribute; *************** static const mstring attr_bits[] = *** 1563,1568 **** --- 1683,1711 ---- minit ("ZERO_COMP", AB_ZERO_COMP), minit ("PROTECTED", AB_PROTECTED), minit ("ABSTRACT", AB_ABSTRACT), + minit ("EXTENSION", AB_EXTENSION), + minit ("PROCEDURE", AB_PROCEDURE), + minit ("PROC_POINTER", AB_PROC_POINTER), + minit (NULL, -1) + }; + + /* For binding attributes. */ + static const mstring binding_passing[] = + { + minit ("PASS", 0), + minit ("NOPASS", 1), + minit (NULL, -1) + }; + static const mstring binding_overriding[] = + { + minit ("OVERRIDABLE", 0), + minit ("NON_OVERRIDABLE", 1), + minit (NULL, -1) + }; + static const mstring binding_generic[] = + { + minit ("SPECIFIC", 0), + minit ("GENERIC", 1), minit (NULL, -1) }; *************** mio_symbol_attribute (symbol_attribute * *** 1616,1622 **** MIO_NAME (ab_attribute) (AB_OPTIONAL, attr_bits); if (attr->pointer) MIO_NAME (ab_attribute) (AB_POINTER, attr_bits); ! if (attr->protected) MIO_NAME (ab_attribute) (AB_PROTECTED, attr_bits); if (attr->value) MIO_NAME (ab_attribute) (AB_VALUE, attr_bits); --- 1759,1765 ---- MIO_NAME (ab_attribute) (AB_OPTIONAL, attr_bits); if (attr->pointer) MIO_NAME (ab_attribute) (AB_POINTER, attr_bits); ! if (attr->is_protected) MIO_NAME (ab_attribute) (AB_PROTECTED, attr_bits); if (attr->value) MIO_NAME (ab_attribute) (AB_VALUE, attr_bits); *************** mio_symbol_attribute (symbol_attribute * *** 1676,1681 **** --- 1819,1830 ---- MIO_NAME (ab_attribute) (AB_PRIVATE_COMP, attr_bits); if (attr->zero_comp) MIO_NAME (ab_attribute) (AB_ZERO_COMP, attr_bits); + if (attr->extension) + MIO_NAME (ab_attribute) (AB_EXTENSION, attr_bits); + if (attr->procedure) + MIO_NAME (ab_attribute) (AB_PROCEDURE, attr_bits); + if (attr->proc_pointer) + MIO_NAME (ab_attribute) (AB_PROC_POINTER, attr_bits); mio_rparen (); *************** mio_symbol_attribute (symbol_attribute * *** 1711,1717 **** attr->pointer = 1; break; case AB_PROTECTED: ! attr->protected = 1; break; case AB_VALUE: attr->value = 1; --- 1860,1866 ---- attr->pointer = 1; break; case AB_PROTECTED: ! attr->is_protected = 1; break; case AB_VALUE: attr->value = 1; *************** mio_symbol_attribute (symbol_attribute * *** 1794,1799 **** --- 1943,1957 ---- case AB_ZERO_COMP: attr->zero_comp = 1; break; + case AB_EXTENSION: + attr->extension = 1; + break; + case AB_PROCEDURE: + attr->procedure = 1; + break; + case AB_PROC_POINTER: + attr->proc_pointer = 1; + break; } } } *************** mio_component (gfc_component *c) *** 2120,2129 **** mio_typespec (&c->ts); mio_array_spec (&c->as); ! mio_integer (&c->dimension); ! mio_integer (&c->pointer); ! mio_integer (&c->allocatable); ! c->access = MIO_NAME (gfc_access) (c->access, access_types); mio_expr (&c->initializer); mio_rparen (); --- 2278,2285 ---- mio_typespec (&c->ts); mio_array_spec (&c->as); ! mio_symbol_attribute (&c->attr); ! c->attr.access = MIO_NAME (gfc_access) (c->attr.access, access_types); mio_expr (&c->initializer); mio_rparen (); *************** mio_symtree_ref (gfc_symtree **stp) *** 2330,2336 **** } else { ! f = gfc_getmem (sizeof (fixup_t)); f->next = p->u.rsym.stfixup; p->u.rsym.stfixup = f; --- 2486,2492 ---- } else { ! f = XCNEW (fixup_t); f->next = p->u.rsym.stfixup; p->u.rsym.stfixup = f; *************** mio_gmp_real (mpfr_t *real) *** 2549,2555 **** return; } ! atom_string = gfc_getmem (strlen (p) + 20); sprintf (atom_string, "0.%s@%ld", p, exponent); --- 2705,2711 ---- return; } ! atom_string = XCNEWVEC (char, strlen (p) + 20); sprintf (atom_string, "0.%s@%ld", p, exponent); *************** static const mstring expr_types[] = { *** 2620,2625 **** --- 2776,2782 ---- minit ("STRUCTURE", EXPR_STRUCTURE), minit ("ARRAY", EXPR_ARRAY), minit ("NULL", EXPR_NULL), + minit ("COMPCALL", EXPR_COMPCALL), minit (NULL, -1) }; *************** mio_expr (gfc_expr **ep) *** 2748,2757 **** switch (e->expr_type) { case EXPR_OP: ! e->value.op.operator ! = MIO_NAME (gfc_intrinsic_op) (e->value.op.operator, intrinsics); ! switch (e->value.op.operator) { case INTRINSIC_UPLUS: case INTRINSIC_UMINUS: --- 2905,2914 ---- switch (e->expr_type) { case EXPR_OP: ! e->value.op.op ! = MIO_NAME (gfc_intrinsic_op) (e->value.op.op, intrinsics); ! switch (e->value.op.op) { case INTRINSIC_UPLUS: case INTRINSIC_UMINUS: *************** mio_expr (gfc_expr **ep) *** 2833,2839 **** case EXPR_SUBSTRING: e->value.character.string ! = CONST_CAST (char *, mio_allocated_string (e->value.character.string)); mio_ref_list (&e->ref); break; --- 2990,2998 ---- case EXPR_SUBSTRING: e->value.character.string ! = CONST_CAST (gfc_char_t *, ! mio_allocated_wide_string (e->value.character.string, ! e->value.character.length)); mio_ref_list (&e->ref); break; *************** mio_expr (gfc_expr **ep) *** 2868,2874 **** case BT_CHARACTER: mio_integer (&e->value.character.length); e->value.character.string ! = CONST_CAST (char *, mio_allocated_string (e->value.character.string)); break; default: --- 3027,3035 ---- case BT_CHARACTER: mio_integer (&e->value.character.length); e->value.character.string ! = CONST_CAST (gfc_char_t *, ! mio_allocated_wide_string (e->value.character.string, ! e->value.character.length)); break; default: *************** mio_expr (gfc_expr **ep) *** 2879,2884 **** --- 3040,3049 ---- case EXPR_NULL: break; + + case EXPR_COMPCALL: + gcc_unreachable (); + break; } mio_rparen (); *************** mio_namelist (gfc_symbol *sym) *** 2933,2939 **** } ! /* Save/restore lists of gfc_interface stuctures. When loading an interface, we are really appending to the existing list of interfaces. Checking for duplicate and ambiguous interfaces has to be done later when all symbols have been loaded. */ --- 3098,3104 ---- } ! /* Save/restore lists of gfc_interface structures. When loading an interface, we are really appending to the existing list of interfaces. Checking for duplicate and ambiguous interfaces has to be done later when all symbols have been loaded. */ *************** mio_namespace_ref (gfc_namespace **nsp) *** 3032,3037 **** --- 3197,3379 ---- } + /* Save/restore the f2k_derived namespace of a derived-type symbol. */ + + static gfc_namespace* current_f2k_derived; + + static void + mio_typebound_proc (gfc_typebound_proc** proc) + { + int flag; + + if (iomode == IO_INPUT) + { + *proc = gfc_get_typebound_proc (); + (*proc)->where = gfc_current_locus; + } + gcc_assert (*proc); + + mio_lparen (); + + (*proc)->access = MIO_NAME (gfc_access) ((*proc)->access, access_types); + + (*proc)->nopass = mio_name ((*proc)->nopass, binding_passing); + (*proc)->non_overridable = mio_name ((*proc)->non_overridable, + binding_overriding); + (*proc)->is_generic = mio_name ((*proc)->is_generic, binding_generic); + + if (iomode == IO_INPUT) + (*proc)->pass_arg = NULL; + + flag = (int) (*proc)->pass_arg_num; + mio_integer (&flag); + (*proc)->pass_arg_num = (unsigned) flag; + + if ((*proc)->is_generic) + { + gfc_tbp_generic* g; + + mio_lparen (); + + if (iomode == IO_OUTPUT) + for (g = (*proc)->u.generic; g; g = g->next) + mio_allocated_string (g->specific_st->name); + else + { + (*proc)->u.generic = NULL; + while (peek_atom () != ATOM_RPAREN) + { + g = gfc_get_tbp_generic (); + g->specific = NULL; + + require_atom (ATOM_STRING); + gfc_get_sym_tree (atom_string, current_f2k_derived, + &g->specific_st); + gfc_free (atom_string); + + g->next = (*proc)->u.generic; + (*proc)->u.generic = g; + } + } + + mio_rparen (); + } + else + mio_symtree_ref (&(*proc)->u.specific); + + mio_rparen (); + } + + static void + mio_typebound_symtree (gfc_symtree* st) + { + if (iomode == IO_OUTPUT && !st->typebound) + return; + + if (iomode == IO_OUTPUT) + { + mio_lparen (); + mio_allocated_string (st->name); + } + /* For IO_INPUT, the above is done in mio_f2k_derived. */ + + mio_typebound_proc (&st->typebound); + mio_rparen (); + } + + static void + mio_finalizer (gfc_finalizer **f) + { + if (iomode == IO_OUTPUT) + { + gcc_assert (*f); + gcc_assert ((*f)->proc_tree); /* Should already be resolved. */ + mio_symtree_ref (&(*f)->proc_tree); + } + else + { + *f = gfc_get_finalizer (); + (*f)->where = gfc_current_locus; /* Value should not matter. */ + (*f)->next = NULL; + + mio_symtree_ref (&(*f)->proc_tree); + (*f)->proc_sym = NULL; + } + } + + static void + mio_f2k_derived (gfc_namespace *f2k) + { + current_f2k_derived = f2k; + + /* Handle the list of finalizer procedures. */ + mio_lparen (); + if (iomode == IO_OUTPUT) + { + gfc_finalizer *f; + for (f = f2k->finalizers; f; f = f->next) + mio_finalizer (&f); + } + else + { + f2k->finalizers = NULL; + while (peek_atom () != ATOM_RPAREN) + { + gfc_finalizer *cur; + mio_finalizer (&cur); + cur->next = f2k->finalizers; + f2k->finalizers = cur; + } + } + mio_rparen (); + + /* Handle type-bound procedures. */ + mio_lparen (); + if (iomode == IO_OUTPUT) + gfc_traverse_symtree (f2k->sym_root, &mio_typebound_symtree); + else + { + while (peek_atom () == ATOM_LPAREN) + { + gfc_symtree* st; + + mio_lparen (); + + require_atom (ATOM_STRING); + gfc_get_sym_tree (atom_string, f2k, &st); + gfc_free (atom_string); + + mio_typebound_symtree (st); + } + } + mio_rparen (); + } + + static void + mio_full_f2k_derived (gfc_symbol *sym) + { + mio_lparen (); + + if (iomode == IO_OUTPUT) + { + if (sym->f2k_derived) + mio_f2k_derived (sym->f2k_derived); + } + else + { + if (peek_atom () != ATOM_RPAREN) + { + sym->f2k_derived = gfc_get_namespace (NULL, 0); + mio_f2k_derived (sym->f2k_derived); + } + else + gcc_assert (!sym->f2k_derived); + } + + mio_rparen (); + } + + /* Unlike most other routines, the address of the symbol node is already fixed on input and the name/module has already been filled in. */ *************** mio_symbol (gfc_symbol *sym) *** 3094,3099 **** --- 3436,3444 ---- sym->component_access = MIO_NAME (gfc_access) (sym->component_access, access_types); + /* Load/save the f2k_derived namespace of a derived-type symbol. */ + mio_full_f2k_derived (sym); + mio_namelist (sym); /* Add the fields that say whether this is from an intrinsic module, *************** find_symtree_for_symbol (gfc_symtree *st *** 3143,3149 **** } ! /* A recursive function to look for a speficic 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 generic interfaces are distinguished as are symbols that have been --- 3488,3494 ---- } ! /* 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 generic interfaces are distinguished as are symbols that have been *************** load_operator_interfaces (void) *** 3254,3269 **** if (i == 1) { uop = gfc_get_uop (p); ! pi = mio_interface_rest (&uop->operator); } else { if (gfc_find_uop (p, NULL)) continue; uop = gfc_get_uop (p); ! uop->operator = gfc_get_interface (); ! uop->operator->where = gfc_current_locus; ! add_fixup (pi->integer, &uop->operator->sym); } } } --- 3599,3614 ---- if (i == 1) { uop = gfc_get_uop (p); ! pi = mio_interface_rest (&uop->op); } else { if (gfc_find_uop (p, NULL)) continue; uop = gfc_get_uop (p); ! uop->op = gfc_get_interface (); ! uop->op->where = gfc_current_locus; ! add_fixup (pi->integer, &uop->op->sym); } } } *************** read_module (void) *** 3870,3876 **** u->found = 1; } ! mio_interface (&gfc_current_ns->operator[i]); } mio_rparen (); --- 4215,4221 ---- u->found = 1; } ! mio_interface (&gfc_current_ns->op[i]); } mio_rparen (); *************** read_module (void) *** 3900,3913 **** if (u->found) continue; ! if (u->operator == INTRINSIC_NONE) { gfc_error ("Symbol '%s' referenced at %L not found in module '%s'", u->use_name, &u->where, module_name); continue; } ! if (u->operator == INTRINSIC_USER) { gfc_error ("User operator '%s' referenced at %L not found " "in module '%s'", u->use_name, &u->where, module_name); --- 4245,4258 ---- if (u->found) continue; ! if (u->op == INTRINSIC_NONE) { gfc_error ("Symbol '%s' referenced at %L not found in module '%s'", u->use_name, &u->where, module_name); continue; } ! if (u->op == INTRINSIC_USER) { gfc_error ("User operator '%s' referenced at %L not found " "in module '%s'", u->use_name, &u->where, module_name); *************** read_module (void) *** 3915,3921 **** } gfc_error ("Intrinsic operator '%s' referenced at %L not found " ! "in module '%s'", gfc_op2string (u->operator), &u->where, module_name); } --- 4260,4266 ---- } gfc_error ("Intrinsic operator '%s' referenced at %L not found " ! "in module '%s'", gfc_op2string (u->op), &u->where, module_name); } *************** free_written_common (struct written_comm *** 3992,3998 **** /* Write a common block to the module -- recursive helper function. */ static void ! write_common_0 (gfc_symtree *st) { gfc_common_head *p; const char * name; --- 4337,4343 ---- /* Write a common block to the module -- recursive helper function. */ static void ! write_common_0 (gfc_symtree *st, bool this_module) { gfc_common_head *p; const char * name; *************** write_common_0 (gfc_symtree *st) *** 4004,4010 **** if (st == NULL) return; ! write_common_0 (st->left); /* We will write out the binding label, or the name if no label given. */ name = st->n.common->name; --- 4349,4355 ---- if (st == NULL) return; ! write_common_0 (st->left, this_module); /* We will write out the binding label, or the name if no label given. */ name = st->n.common->name; *************** write_common_0 (gfc_symtree *st) *** 4023,4028 **** --- 4368,4376 ---- w = (c < 0) ? w->left : w->right; } + if (this_module && p->use_assoc) + write_me = false; + if (write_me) { /* Write the common to the module. */ *************** write_common_0 (gfc_symtree *st) *** 4042,4054 **** mio_rparen (); /* Record that we have written this common. */ ! w = gfc_getmem (sizeof (struct written_common)); ! w->name = name; w->label = label; gfc_insert_bbt (&written_commons, w, compare_written_commons); } ! write_common_0 (st->right); } --- 4390,4402 ---- mio_rparen (); /* Record that we have written this common. */ ! w = XCNEW (struct written_common); ! w->name = p->name; w->label = label; gfc_insert_bbt (&written_commons, w, compare_written_commons); } ! write_common_0 (st->right, this_module); } *************** static void *** 4059,4065 **** write_common (gfc_symtree *st) { written_commons = NULL; ! write_common_0 (st); free_written_common (written_commons); written_commons = NULL; } --- 4407,4414 ---- write_common (gfc_symtree *st) { written_commons = NULL; ! write_common_0 (st, true); ! write_common_0 (st, false); free_written_common (written_commons); written_commons = NULL; } *************** write_operator (gfc_user_op *uop) *** 4235,4245 **** static char nullstring[] = ""; const char *p = nullstring; ! if (uop->operator == NULL || !gfc_check_access (uop->access, uop->ns->default_access)) return; ! mio_symbol_interface (&uop->name, &p, &uop->operator); } --- 4584,4594 ---- static char nullstring[] = ""; const char *p = nullstring; ! if (uop->op == NULL || !gfc_check_access (uop->access, uop->ns->default_access)) return; ! mio_symbol_interface (&uop->name, &p, &uop->op); } *************** write_module (void) *** 4319,4325 **** mio_interface (gfc_check_access (gfc_current_ns->operator_access[i], gfc_current_ns->default_access) ! ? &gfc_current_ns->operator[i] : NULL); } mio_rparen (); --- 4668,4674 ---- mio_interface (gfc_check_access (gfc_current_ns->operator_access[i], gfc_current_ns->default_access) ! ? &gfc_current_ns->op[i] : NULL); } mio_rparen (); *************** read_md5_from_module_file (const char * *** 4390,4397 **** return -1; /* Read two lines. */ ! if (fgets (buf, sizeof (buf) - 1, file) == NULL ! || fgets (buf, sizeof (buf) - 1, file) == NULL) { fclose (file); return -1; --- 4739,4756 ---- return -1; /* Read two lines. */ ! if (fgets (buf, sizeof (buf) - 1, file) == NULL) ! { ! fclose (file); ! return -1; ! } ! ! /* The file also needs to be overwritten if the version number changed. */ ! n = strlen ("GFORTRAN module version '" MOD_VERSION "' created"); ! if (strncmp (buf, "GFORTRAN module version '" MOD_VERSION "' created", n) != 0) ! return -1; ! ! if (fgets (buf, sizeof (buf) - 1, file) == NULL) { fclose (file); return -1; *************** gfc_dump_module (const char *name, int d *** 4472,4479 **** *strchr (p, '\n') = '\0'; ! fprintf (module_fp, "GFORTRAN module created from %s on %s\nMD5:", ! gfc_source_file, p); fgetpos (module_fp, &md5_pos); fputs ("00000000000000000000000000000000 -- " "If you edit this, you'll get what you deserve.\n\n", module_fp); --- 4831,4838 ---- *strchr (p, '\n') = '\0'; ! fprintf (module_fp, "GFORTRAN module version '%s' created from %s on %s\n" ! "MD5:", MOD_VERSION, gfc_source_file, p); fgetpos (module_fp, &md5_pos); fputs ("00000000000000000000000000000000 -- " "If you edit this, you'll get what you deserve.\n\n", module_fp); *************** gfc_dump_module (const char *name, int d *** 4509,4519 **** || memcmp (md5_old, md5_new, sizeof (md5_old)) != 0) { /* Module file have changed, replace the old one. */ ! unlink (filename); ! rename (filename_tmp, filename); } else ! unlink (filename_tmp); } --- 4868,4886 ---- || memcmp (md5_old, md5_new, sizeof (md5_old)) != 0) { /* Module file have changed, replace the old one. */ ! if (unlink (filename) && errno != ENOENT) ! gfc_fatal_error ("Can't delete module file '%s': %s", filename, ! strerror (errno)); ! if (rename (filename_tmp, filename)) ! gfc_fatal_error ("Can't rename module file '%s' to '%s': %s", ! filename_tmp, filename, strerror (errno)); } else ! { ! if (unlink (filename_tmp)) ! gfc_fatal_error ("Can't delete temporary module file '%s': %s", ! filename_tmp, strerror (errno)); ! } } *************** use_iso_fortran_env_module (void) *** 4696,4708 **** int i; intmod_sym symbol[] = { ! #define NAMED_INTCST(a,b,c) { a, b, 0 }, #include "iso-fortran-env.def" #undef NAMED_INTCST ! { ISOFORTRANENV_INVALID, NULL, -1234 } }; i = 0; ! #define NAMED_INTCST(a,b,c) symbol[i++].value = c; #include "iso-fortran-env.def" #undef NAMED_INTCST --- 5063,5075 ---- int i; intmod_sym symbol[] = { ! #define NAMED_INTCST(a,b,c,d) { a, b, 0, d }, #include "iso-fortran-env.def" #undef NAMED_INTCST ! { ISOFORTRANENV_INVALID, NULL, -1234, 0 } }; i = 0; ! #define NAMED_INTCST(a,b,c,d) symbol[i++].value = c; #include "iso-fortran-env.def" #undef NAMED_INTCST *************** gfc_use_module (void) *** 4802,4807 **** --- 5169,5175 ---- gfc_state_data *p; int c, line, start; gfc_symtree *mod_symtree; + gfc_use_list *use_stmt; filename = (char *) alloca (strlen (module_name) + strlen (MODULE_EXTENSION) + 1); *************** gfc_use_module (void) *** 4866,4877 **** c = module_char (); if (c == EOF) bad_module ("Unexpected end of module"); ! if (start++ < 2) parse_name (c); if ((start == 1 && strcmp (atom_name, "GFORTRAN") != 0) || (start == 2 && strcmp (atom_name, " module") != 0)) gfc_fatal_error ("File '%s' opened at %C is not a GFORTRAN module " "file", filename); if (c == '\n') line++; --- 5234,5260 ---- c = module_char (); if (c == EOF) bad_module ("Unexpected end of module"); ! if (start++ < 3) parse_name (c); if ((start == 1 && strcmp (atom_name, "GFORTRAN") != 0) || (start == 2 && strcmp (atom_name, " module") != 0)) gfc_fatal_error ("File '%s' opened at %C is not a GFORTRAN module " "file", filename); + if (start == 3) + { + if (strcmp (atom_name, " version") != 0 + || module_char () != ' ' + || parse_atom () != ATOM_STRING) + gfc_fatal_error ("Parse error when checking module version" + " for file '%s' opened at %C", filename); + + if (strcmp (atom_string, MOD_VERSION)) + { + gfc_fatal_error ("Wrong module version '%s' (expected '" + MOD_VERSION "') for file '%s' opened" + " at %C", atom_string, filename); + } + } if (c == '\n') line++; *************** gfc_use_module (void) *** 4894,4899 **** --- 5277,5310 ---- pi_root = NULL; fclose (module_fp); + + use_stmt = gfc_get_use_list (); + use_stmt->module_name = gfc_get_string (module_name); + use_stmt->only_flag = only_flag; + use_stmt->rename = gfc_rename_list; + use_stmt->where = use_locus; + gfc_rename_list = NULL; + use_stmt->next = gfc_current_ns->use_stmts; + gfc_current_ns->use_stmts = use_stmt; + } + + + void + gfc_free_use_stmts (gfc_use_list *use_stmts) + { + gfc_use_list *next; + for (; use_stmts; use_stmts = next) + { + gfc_use_rename *next_rename; + + for (; use_stmts->rename; use_stmts->rename = next_rename) + { + next_rename = use_stmts->rename->next; + gfc_free (use_stmts->rename); + } + next = use_stmts->next; + gfc_free (use_stmts); + } } diff -Nrcpad gcc-4.3.3/gcc/fortran/openmp.c gcc-4.4.0/gcc/fortran/openmp.c *** gcc-4.3.3/gcc/fortran/openmp.c Thu Apr 3 21:20:53 2008 --- gcc-4.4.0/gcc/fortran/openmp.c Sat Jul 19 16:22:12 2008 *************** *** 1,5 **** /* OpenMP directive matching and resolving. ! Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Jakub Jelinek --- 1,5 ---- /* OpenMP directive matching and resolving. ! Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Jakub Jelinek *************** match *** 36,52 **** gfc_match_omp_eos (void) { locus old_loc; ! int c; old_loc = gfc_current_locus; gfc_gobble_whitespace (); ! c = gfc_next_char (); switch (c) { case '!': do ! c = gfc_next_char (); while (c != '\n'); /* Fall through */ --- 36,52 ---- gfc_match_omp_eos (void) { locus old_loc; ! char c; old_loc = gfc_current_locus; gfc_gobble_whitespace (); ! c = gfc_next_ascii_char (); switch (c) { case '!': do ! c = gfc_next_ascii_char (); while (c != '\n'); /* Fall through */ *************** cleanup: *** 182,187 **** --- 182,189 ---- #define OMP_CLAUSE_SCHEDULE (1 << 9) #define OMP_CLAUSE_DEFAULT (1 << 10) #define OMP_CLAUSE_ORDERED (1 << 11) + #define OMP_CLAUSE_COLLAPSE (1 << 12) + #define OMP_CLAUSE_UNTIED (1 << 13) /* Match OpenMP directive clauses. MASK is a bitmask of clauses that are allowed for a particular directive. */ *************** gfc_match_omp_clauses (gfc_omp_clauses * *** 335,340 **** --- 337,344 ---- c->default_sharing = OMP_DEFAULT_PRIVATE; else if (gfc_match ("default ( none )") == MATCH_YES) c->default_sharing = OMP_DEFAULT_NONE; + else if (gfc_match ("default ( firstprivate )") == MATCH_YES) + c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE; if (c->default_sharing != OMP_DEFAULT_UNKNOWN) continue; } *************** gfc_match_omp_clauses (gfc_omp_clauses * *** 351,360 **** c->sched_kind = OMP_SCHED_GUIDED; else if (gfc_match ("runtime") == MATCH_YES) c->sched_kind = OMP_SCHED_RUNTIME; if (c->sched_kind != OMP_SCHED_NONE) { match m = MATCH_NO; ! if (c->sched_kind != OMP_SCHED_RUNTIME) m = gfc_match (" , %e )", &c->chunk_size); if (m != MATCH_YES) m = gfc_match_char (')'); --- 355,367 ---- 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) { 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 (')'); *************** gfc_match_omp_clauses (gfc_omp_clauses * *** 372,377 **** --- 379,414 ---- 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_COLLAPSE) && !c->collapse) + { + gfc_expr *cexpr = NULL; + match m = gfc_match ("collapse ( %e )", &cexpr); + + if (m == MATCH_YES) + { + int collapse; + const char *p = gfc_extract_int (cexpr, &collapse); + if (p) + { + gfc_error (p); + collapse = 1; + } + else if (collapse <= 0) + { + gfc_error ("COLLAPSE clause argument not constant positive integer at %C"); + collapse = 1; + } + c->collapse = collapse; + gfc_free_expr (cexpr); + continue; + } + } break; } *************** gfc_match_omp_clauses (gfc_omp_clauses * *** 393,402 **** #define OMP_DO_CLAUSES \ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \ ! | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED) #define OMP_SECTIONS_CLAUSES \ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) match gfc_match_omp_parallel (void) --- 430,442 ---- #define OMP_DO_CLAUSES \ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \ ! | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE) #define OMP_SECTIONS_CLAUSES \ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) + #define OMP_TASK_CLAUSES \ + (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \ + | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED) match gfc_match_omp_parallel (void) *************** gfc_match_omp_parallel (void) *** 411,416 **** --- 451,479 ---- match + gfc_match_omp_task (void) + { + gfc_omp_clauses *c; + if (gfc_match_omp_clauses (&c, OMP_TASK_CLAUSES) != MATCH_YES) + return MATCH_ERROR; + new_st.op = EXEC_OMP_TASK; + new_st.ext.omp_clauses = c; + return MATCH_YES; + } + + + match + gfc_match_omp_taskwait (void) + { + if (gfc_match_omp_eos () != MATCH_YES) + return MATCH_ERROR; + new_st.op = EXEC_OMP_TASKWAIT; + new_st.ext.omp_clauses = NULL; + return MATCH_YES; + } + + + match gfc_match_omp_critical (void) { char n[GFC_MAX_SYMBOL_LEN+1]; *************** resolve_omp_clauses (gfc_code *code) *** 809,817 **** if (!n->sym->attr.threadprivate) gfc_error ("Non-THREADPRIVATE object '%s' in COPYIN clause" " at %L", n->sym->name, &code->loc); - if (n->sym->attr.allocatable) - gfc_error ("COPYIN clause object '%s' is ALLOCATABLE at %L", - n->sym->name, &code->loc); if (n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp) gfc_error ("COPYIN clause object '%s' at %L has ALLOCATABLE components", n->sym->name, &code->loc); --- 872,877 ---- *************** resolve_omp_clauses (gfc_code *code) *** 823,831 **** if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE) gfc_error ("Assumed size array '%s' in COPYPRIVATE clause " "at %L", n->sym->name, &code->loc); - if (n->sym->attr.allocatable) - gfc_error ("COPYPRIVATE clause object '%s' is ALLOCATABLE " - "at %L", n->sym->name, &code->loc); if (n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp) gfc_error ("COPYPRIVATE clause object '%s' at %L has ALLOCATABLE components", n->sym->name, &code->loc); --- 883,888 ---- *************** resolve_omp_clauses (gfc_code *code) *** 856,864 **** if (n->sym->attr.pointer) gfc_error ("POINTER object '%s' in %s clause at %L", n->sym->name, name, &code->loc); - if (n->sym->attr.allocatable) - gfc_error ("%s clause object '%s' is ALLOCATABLE at %L", - name, n->sym->name, &code->loc); /* Variables in REDUCTION-clauses must be of intrinsic type (flagged below). */ if ((list < OMP_LIST_REDUCTION_FIRST || list > OMP_LIST_REDUCTION_LAST) && n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp) --- 913,918 ---- *************** resolve_omp_atomic (gfc_code *code) *** 1039,1045 **** if (expr2->expr_type == EXPR_OP) { gfc_expr *v = NULL, *e, *c; ! gfc_intrinsic_op op = expr2->value.op.operator; gfc_intrinsic_op alt_op = INTRINSIC_NONE; switch (op) --- 1093,1099 ---- if (expr2->expr_type == EXPR_OP) { gfc_expr *v = NULL, *e, *c; ! gfc_intrinsic_op op = expr2->value.op.op; gfc_intrinsic_op alt_op = INTRINSIC_NONE; switch (op) *************** resolve_omp_atomic (gfc_code *code) *** 1102,1109 **** else if ((c = is_conversion (e, true)) != NULL) q = &e->value.function.actual->expr; else if (e->expr_type != EXPR_OP ! || (e->value.op.operator != op ! && e->value.op.operator != alt_op) || e->rank != 0) break; else --- 1156,1163 ---- else if ((c = is_conversion (e, true)) != NULL) q = &e->value.function.actual->expr; else if (e->expr_type != EXPR_OP ! || (e->value.op.op != op ! && e->value.op.op != alt_op) || e->rank != 0) break; else *************** resolve_omp_atomic (gfc_code *code) *** 1122,1128 **** if (p != NULL) { e = *p; ! switch (e->value.op.operator) { case INTRINSIC_MINUS: case INTRINSIC_DIVIDE: --- 1176,1182 ---- if (p != NULL) { e = *p; ! switch (e->value.op.op) { case INTRINSIC_MINUS: case INTRINSIC_DIVIDE: *************** struct omp_context *** 1246,1260 **** struct pointer_set_t *private_iterators; struct omp_context *previous; } *omp_current_ctx; ! gfc_code *omp_current_do_code; ! void gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns) { if (code->block->next && code->block->next->op == EXEC_DO) ! omp_current_do_code = code->block->next; gfc_resolve_blocks (code->block, ns); } --- 1300,1333 ---- struct pointer_set_t *private_iterators; struct omp_context *previous; } *omp_current_ctx; ! static gfc_code *omp_current_do_code; ! static int omp_current_do_collapse; void gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns) { if (code->block->next && code->block->next->op == EXEC_DO) ! { ! int i; ! gfc_code *c; ! ! omp_current_do_code = code->block->next; ! 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; ! if (c->op != EXEC_DO || c->next == NULL) ! break; ! c = c->next; ! if (c->op != EXEC_DO) ! break; ! } ! if (i < omp_current_do_collapse || omp_current_do_collapse <= 0) ! omp_current_do_collapse = 1; ! } gfc_resolve_blocks (code->block, ns); + omp_current_do_collapse = 0; + omp_current_do_code = NULL; } *************** void *** 1294,1299 **** --- 1367,1374 ---- gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym) { struct omp_context *ctx; + int i = omp_current_do_collapse; + gfc_code *c = omp_current_do_code; if (sym->attr.threadprivate) return; *************** gfc_resolve_do_iterator (gfc_code *code, *** 1301,1308 **** /* !$omp do and !$omp parallel do iteration variable is predetermined private just in the !$omp do resp. !$omp parallel do construct, with no implications for the outer parallel constructs. */ ! if (code == omp_current_do_code) ! return; for (ctx = omp_current_ctx; ctx; ctx = ctx->previous) { --- 1376,1389 ---- /* !$omp do and !$omp parallel do iteration variable is predetermined private just in the !$omp do resp. !$omp parallel do construct, with no implications for the outer parallel constructs. */ ! ! while (i-- >= 1) ! { ! if (code == c) ! return; ! ! c = c->block->next; ! } for (ctx = omp_current_ctx; ctx; ctx = ctx->previous) { *************** gfc_resolve_do_iterator (gfc_code *code, *** 1326,1333 **** static void resolve_omp_do (gfc_code *code) { ! gfc_code *do_code; ! int list; gfc_namelist *n; gfc_symbol *dovar; --- 1407,1414 ---- static void resolve_omp_do (gfc_code *code) { ! gfc_code *do_code, *c; ! int list, i, collapse; gfc_namelist *n; gfc_symbol *dovar; *************** resolve_omp_do (gfc_code *code) *** 1335,1345 **** resolve_omp_clauses (code); do_code = code->block->next; ! if (do_code->op == EXEC_DO_WHILE) ! gfc_error ("!$OMP DO cannot be a DO WHILE or DO without loop control " ! "at %L", &do_code->loc); ! else { gcc_assert (do_code->op == EXEC_DO); if (do_code->ext.iterator->var->ts.type != BT_INTEGER) gfc_error ("!$OMP DO iteration variable must be of type integer at %L", --- 1416,1432 ---- resolve_omp_clauses (code); do_code = code->block->next; ! collapse = code->ext.omp_clauses->collapse; ! if (collapse <= 0) ! collapse = 1; ! for (i = 1; i <= collapse; i++) { + if (do_code->op == EXEC_DO_WHILE) + { + gfc_error ("!$OMP DO cannot be a DO WHILE or DO without loop control " + "at %L", &do_code->loc); + break; + } gcc_assert (do_code->op == EXEC_DO); if (do_code->ext.iterator->var->ts.type != BT_INTEGER) gfc_error ("!$OMP DO iteration variable must be of type integer at %L", *************** resolve_omp_do (gfc_code *code) *** 1359,1364 **** --- 1446,1498 ---- &do_code->loc); break; } + if (i > 1) + { + gfc_code *do_code2 = code->block->next; + int j; + + for (j = 1; j < i; j++) + { + gfc_symbol *ivar = do_code2->ext.iterator->var->symtree->n.sym; + if (dovar == ivar + || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->start) + || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->end) + || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->step)) + { + gfc_error ("!$OMP DO collapsed loops don't form rectangular iteration space at %L", + &do_code->loc); + break; + } + if (j < i) + break; + do_code2 = do_code2->block->next; + } + } + if (i == collapse) + break; + for (c = do_code->next; c; c = c->next) + if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE) + { + gfc_error ("collapsed !$OMP DO loops not perfectly nested at %L", + &c->loc); + break; + } + if (c) + break; + do_code = do_code->block; + if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE) + { + gfc_error ("not enough DO loops for collapsed !$OMP DO at %L", + &code->loc); + break; + } + do_code = do_code->next; + if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE) + { + gfc_error ("not enough DO loops for collapsed !$OMP DO at %L", + &code->loc); + break; + } } } diff -Nrcpad gcc-4.3.3/gcc/fortran/options.c gcc-4.4.0/gcc/fortran/options.c *** gcc-4.3.3/gcc/fortran/options.c Mon Nov 26 22:14:20 2007 --- gcc-4.4.0/gcc/fortran/options.c Mon Nov 3 07:20:24 2008 *************** *** 1,5 **** /* Parse and display command line options. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Parse and display command line options. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Andy Vaught *************** along with GCC; see the file COPYING3. *** 31,80 **** #include "tree-inline.h" #include "gfortran.h" #include "target.h" gfc_option_t gfc_option; /* Set flags that control warnings and errors for different ! Fortran standards to their default values. */ static void set_default_std_flags (void) { gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL ! | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F77 | GFC_STD_GNU ! | GFC_STD_LEGACY; gfc_option.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY; } ! /* Get ready for options handling. */ unsigned int ! gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED, ! const char **argv ATTRIBUTE_UNUSED) { gfc_source_file = NULL; gfc_option.module_dir = NULL; gfc_option.source_form = FORM_UNKNOWN; gfc_option.fixed_line_length = 72; gfc_option.free_line_length = 132; ! gfc_option.max_continue_fixed = 19; ! gfc_option.max_continue_free = 39; gfc_option.max_identifier_length = GFC_MAX_SYMBOL_LEN; gfc_option.max_subrecord_length = 0; gfc_option.convert = GFC_CONVERT_NATIVE; gfc_option.record_marker = 0; ! gfc_option.verbose = 0; gfc_option.warn_aliasing = 0; gfc_option.warn_ampersand = 0; gfc_option.warn_character_truncation = 0; gfc_option.warn_conversion = 0; gfc_option.warn_implicit_interface = 0; gfc_option.warn_line_truncation = 0; gfc_option.warn_surprising = 0; gfc_option.warn_tabs = 1; gfc_option.warn_underflow = 1; gfc_option.max_errors = 25; gfc_option.flag_all_intrinsics = 0; --- 31,88 ---- #include "tree-inline.h" #include "gfortran.h" #include "target.h" + #include "cpp.h" gfc_option_t gfc_option; /* Set flags that control warnings and errors for different ! Fortran standards to their default values. Keep in sync with ! libgfortran/runtime/compile_options.c (init_compile_options). */ static void set_default_std_flags (void) { gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL ! | GFC_STD_F2003 | GFC_STD_F2008 | GFC_STD_F95 | GFC_STD_F77 ! | GFC_STD_GNU | GFC_STD_LEGACY; gfc_option.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY; } ! ! /* Get ready for options handling. Keep in sync with ! libgfortran/runtime/compile_options.c (init_compile_options). */ unsigned int ! gfc_init_options (unsigned int argc, const char **argv) { gfc_source_file = NULL; gfc_option.module_dir = NULL; gfc_option.source_form = FORM_UNKNOWN; gfc_option.fixed_line_length = 72; gfc_option.free_line_length = 132; ! gfc_option.max_continue_fixed = 255; ! gfc_option.max_continue_free = 255; gfc_option.max_identifier_length = GFC_MAX_SYMBOL_LEN; gfc_option.max_subrecord_length = 0; + gfc_option.flag_max_array_constructor = 65535; gfc_option.convert = GFC_CONVERT_NATIVE; gfc_option.record_marker = 0; ! gfc_option.dump_parse_tree = 0; gfc_option.warn_aliasing = 0; gfc_option.warn_ampersand = 0; gfc_option.warn_character_truncation = 0; + gfc_option.warn_array_temp = 0; gfc_option.warn_conversion = 0; gfc_option.warn_implicit_interface = 0; gfc_option.warn_line_truncation = 0; gfc_option.warn_surprising = 0; gfc_option.warn_tabs = 1; gfc_option.warn_underflow = 1; + gfc_option.warn_intrinsic_shadow = 0; + gfc_option.warn_intrinsics_std = 0; + gfc_option.warn_align_commons = 1; gfc_option.max_errors = 25; gfc_option.flag_all_intrinsics = 0; *************** gfc_init_options (unsigned int argc ATTR *** 98,103 **** --- 106,112 ---- gfc_option.flag_backslash = 0; gfc_option.flag_module_private = 0; gfc_option.flag_backtrace = 0; + gfc_option.flag_check_array_temporaries = 0; gfc_option.flag_allow_leading_underscore = 0; gfc_option.flag_dump_core = 0; gfc_option.flag_external_blas = 0; *************** gfc_init_options (unsigned int argc ATTR *** 113,118 **** --- 122,128 ---- gfc_option.flag_init_logical = GFC_INIT_LOGICAL_OFF; gfc_option.flag_init_character = GFC_INIT_CHARACTER_OFF; gfc_option.flag_init_character_value = (char)0; + gfc_option.flag_align_commons = 1; gfc_option.fpe = 0; *************** gfc_init_options (unsigned int argc ATTR *** 123,133 **** set_default_std_flags (); - gfc_option.warn_nonstd_intrinsics = 0; - /* -fshort-enums can be default on some targets. */ gfc_option.fshort_enums = targetm.default_short_enums (); return CL_Fortran; } --- 133,144 ---- set_default_std_flags (); /* -fshort-enums can be default on some targets. */ gfc_option.fshort_enums = targetm.default_short_enums (); + /* Initialize cpp-related options. */ + gfc_cpp_init_options(argc, argv); + return CL_Fortran; } *************** form_from_filename (const char *filename *** 155,160 **** --- 166,174 ---- ".f03", FORM_FREE} , { + ".f08", FORM_FREE} + , + { ".f", FORM_FIXED} , { *************** gfc_post_options (const char **pfilename *** 248,260 **** if (i != 0) { ! source_path = alloca (i + 1); memcpy (source_path, canon_source_file, i); source_path[i] = 0; ! gfc_add_include_path (source_path, true); } else ! gfc_add_include_path (".", true); if (canon_source_file != gfc_source_file) gfc_free (CONST_CAST (char *, canon_source_file)); --- 262,274 ---- if (i != 0) { ! source_path = (char *) alloca (i + 1); memcpy (source_path, canon_source_file, i); source_path[i] = 0; ! gfc_add_include_path (source_path, true, true); } else ! gfc_add_include_path (".", true, true); if (canon_source_file != gfc_source_file) gfc_free (CONST_CAST (char *, canon_source_file)); *************** gfc_post_options (const char **pfilename *** 286,299 **** gfc_warning_now ("'-fd-lines-as-code' has no effect in free form"); } - flag_inline_trees = 1; - - /* Use tree inlining. */ - if (!flag_no_inline) - flag_no_inline = 1; - if (flag_inline_functions) - flag_inline_trees = 2; - /* If -pedantic, warn about the use of GNU extensions. */ if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0) gfc_option.warn_std |= GFC_STD_GNU; --- 300,305 ---- *************** gfc_post_options (const char **pfilename *** 348,356 **** gfc_option.warn_tabs = 0; } ! if (gfc_option.flag_all_intrinsics) ! gfc_option.warn_nonstd_intrinsics = 0; return false; } --- 354,368 ---- gfc_option.warn_tabs = 0; } ! gfc_cpp_post_options (); ! ! /* FIXME: return gfc_cpp_preprocess_only (); + The return value of this function indicates whether the + backend needs to be initialized. On -E, we don't need + the backend. However, if we return 'true' here, an + ICE occurs. Initializing the backend doesn't hurt much, + hence, for now we can live with it as is. */ return false; } *************** set_Wall (int setting) *** 363,375 **** gfc_option.warn_aliasing = setting; gfc_option.warn_ampersand = setting; gfc_option.warn_line_truncation = setting; - gfc_option.warn_nonstd_intrinsics = setting; gfc_option.warn_surprising = setting; gfc_option.warn_tabs = !setting; gfc_option.warn_underflow = setting; gfc_option.warn_character_truncation = setting; ! set_Wunused (setting); warn_return_type = setting; warn_switch = setting; --- 375,388 ---- gfc_option.warn_aliasing = setting; gfc_option.warn_ampersand = setting; gfc_option.warn_line_truncation = setting; gfc_option.warn_surprising = setting; gfc_option.warn_tabs = !setting; gfc_option.warn_underflow = setting; + gfc_option.warn_intrinsic_shadow = setting; + gfc_option.warn_intrinsics_std = setting; gfc_option.warn_character_truncation = setting; ! warn_unused = setting; warn_return_type = setting; warn_switch = setting; *************** gfc_handle_module_path_options (const ch *** 388,409 **** { if (gfc_option.module_dir != NULL) ! { ! gfc_status ("gfortran: Only one -M option allowed\n"); ! exit (3); ! } ! ! if (arg == NULL) ! { ! gfc_status ("gfortran: Directory required after -M\n"); ! exit (3); ! } gfc_option.module_dir = (char *) gfc_getmem (strlen (arg) + 2); strcpy (gfc_option.module_dir, arg); strcat (gfc_option.module_dir, "/"); ! gfc_add_include_path (gfc_option.module_dir, true); } --- 401,413 ---- { if (gfc_option.module_dir != NULL) ! gfc_fatal_error ("gfortran: Only one -J option allowed"); gfc_option.module_dir = (char *) gfc_getmem (strlen (arg) + 2); strcpy (gfc_option.module_dir, arg); strcat (gfc_option.module_dir, "/"); ! gfc_add_include_path (gfc_option.module_dir, true, false); } *************** gfc_handle_option (size_t scode, const c *** 458,463 **** --- 462,470 ---- if (code == N_OPTS) return 1; + if (gfc_cpp_handle_option (scode, arg, value) == 1) + return 1; + switch (code) { default: *************** gfc_handle_option (size_t scode, const c *** 476,481 **** --- 483,492 ---- gfc_option.warn_ampersand = value; break; + case OPT_Warray_temporaries: + gfc_option.warn_array_temp = value; + break; + case OPT_Wcharacter_truncation: gfc_option.warn_character_truncation = value; break; *************** gfc_handle_option (size_t scode, const c *** 492,497 **** --- 503,512 ---- gfc_option.warn_line_truncation = value; break; + case OPT_Wreturn_type: + warn_return_type = value; + break; + case OPT_Wsurprising: gfc_option.warn_surprising = value; break; *************** gfc_handle_option (size_t scode, const c *** 504,509 **** --- 519,532 ---- gfc_option.warn_underflow = value; break; + case OPT_Wintrinsic_shadow: + gfc_option.warn_intrinsic_shadow = value; + break; + + case OPT_Walign_commons: + gfc_option.warn_align_commons = value; + break; + case OPT_fall_intrinsics: gfc_option.flag_all_intrinsics = 1; break; *************** gfc_handle_option (size_t scode, const c *** 524,529 **** --- 547,556 ---- gfc_option.flag_backtrace = value; break; + case OPT_fcheck_array_temporaries: + gfc_option.flag_check_array_temporaries = value; + break; + case OPT_fdump_core: gfc_option.flag_dump_core = value; break; *************** gfc_handle_option (size_t scode, const c *** 557,563 **** break; case OPT_fdump_parse_tree: ! gfc_option.verbose = value; break; case OPT_ffixed_form: --- 584,590 ---- break; case OPT_fdump_parse_tree: ! gfc_option.dump_parse_tree = value; break; case OPT_ffixed_form: *************** gfc_handle_option (size_t scode, const c *** 612,621 **** break; case OPT_fintrinsic_modules_path: ! gfc_add_include_path (arg, false); gfc_add_intrinsic_modules_path (arg); break; case OPT_fmax_errors_: gfc_option.max_errors = value; break; --- 639,652 ---- break; case OPT_fintrinsic_modules_path: ! gfc_add_include_path (arg, false, false); gfc_add_intrinsic_modules_path (arg); break; + case OPT_fmax_array_constructor_: + gfc_option.flag_max_array_constructor = value > 65535 ? value : 65535; + break; + case OPT_fmax_errors_: gfc_option.max_errors = value; break; *************** gfc_handle_option (size_t scode, const c *** 694,700 **** else gfc_fatal_error ("Unrecognized option to -finit-real: %s", arg); ! break; case OPT_finit_integer_: gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON; --- 725,731 ---- else gfc_fatal_error ("Unrecognized option to -finit-real: %s", arg); ! break; case OPT_finit_integer_: gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON; *************** gfc_handle_option (size_t scode, const c *** 713,730 **** break; case OPT_I: ! gfc_add_include_path (arg, true); break; case OPT_J: - case OPT_M: gfc_handle_module_path_options (arg); break; ! case OPT_fsign_zero: gfc_option.flag_sign_zero = value; break; ! case OPT_ffpe_trap_: gfc_handle_fpe_trap_option (arg); break; --- 744,760 ---- break; case OPT_I: ! gfc_add_include_path (arg, true, false); break; case OPT_J: gfc_handle_module_path_options (arg); break; ! case OPT_fsign_zero: gfc_option.flag_sign_zero = value; break; ! case OPT_ffpe_trap_: gfc_handle_fpe_trap_option (arg); break; *************** gfc_handle_option (size_t scode, const c *** 732,737 **** --- 762,769 ---- case OPT_std_f95: gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77; gfc_option.warn_std = GFC_STD_F95_OBS; + gfc_option.max_continue_fixed = 19; + gfc_option.max_continue_free = 39; gfc_option.max_identifier_length = 31; gfc_option.warn_ampersand = 1; gfc_option.warn_tabs = 0; *************** gfc_handle_option (size_t scode, const c *** 741,748 **** gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77 | GFC_STD_F2003 | GFC_STD_F95; gfc_option.warn_std = GFC_STD_F95_OBS; ! gfc_option.max_continue_fixed = 255; ! gfc_option.max_continue_free = 255; gfc_option.max_identifier_length = 63; gfc_option.warn_ampersand = 1; gfc_option.warn_tabs = 0; --- 773,787 ---- gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77 | GFC_STD_F2003 | GFC_STD_F95; gfc_option.warn_std = GFC_STD_F95_OBS; ! gfc_option.max_identifier_length = 63; ! gfc_option.warn_ampersand = 1; ! gfc_option.warn_tabs = 0; ! break; ! ! case OPT_std_f2008: ! gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77 ! | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008; ! gfc_option.warn_std = GFC_STD_F95_OBS; gfc_option.max_identifier_length = 63; gfc_option.warn_ampersand = 1; gfc_option.warn_tabs = 0; *************** gfc_handle_option (size_t scode, const c *** 757,764 **** gfc_option.warn_std = 0; break; ! case OPT_Wnonstd_intrinsics: ! gfc_option.warn_nonstd_intrinsics = value; break; case OPT_fshort_enums: --- 796,803 ---- gfc_option.warn_std = 0; break; ! case OPT_Wintrinsics_std: ! gfc_option.warn_intrinsics_std = value; break; case OPT_fshort_enums: *************** gfc_handle_option (size_t scode, const c *** 800,805 **** --- 839,848 ---- case OPT_frecursive: gfc_option.flag_recursive = 1; break; + + case OPT_falign_commons: + gfc_option.flag_align_commons = value; + break; } return result; diff -Nrcpad gcc-4.3.3/gcc/fortran/parse.c gcc-4.4.0/gcc/fortran/parse.c *** gcc-4.3.3/gcc/fortran/parse.c Sat Nov 8 14:17:35 2008 --- gcc-4.4.0/gcc/fortran/parse.c Sat Apr 4 13:19:15 2009 *************** *** 1,5 **** /* Main parser. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Main parser. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Andy Vaught *************** decode_specification_statement (void) *** 100,106 **** { gfc_statement st; locus old_locus; ! int c; if (gfc_match_eos () == MATCH_YES) return ST_NONE; --- 100,106 ---- { gfc_statement st; locus old_locus; ! char c; if (gfc_match_eos () == MATCH_YES) return ST_NONE; *************** decode_specification_statement (void) *** 121,127 **** statement, we eliminate most possibilities by peeking at the first character. */ ! c = gfc_peek_char (); switch (c) { --- 121,127 ---- statement, we eliminate most possibilities by peeking at the first character. */ ! c = gfc_peek_ascii_char (); switch (c) { *************** decode_statement (void) *** 229,235 **** gfc_statement st; locus old_locus; match m; ! int c; #ifdef GFC_DEBUG gfc_symbol_state (); --- 229,235 ---- gfc_statement st; locus old_locus; match m; ! char c; #ifdef GFC_DEBUG gfc_symbol_state (); *************** decode_statement (void) *** 315,321 **** statement, we eliminate most possibilities by peeking at the first character. */ ! c = gfc_peek_char (); switch (c) { --- 315,321 ---- statement, we eliminate most possibilities by peeking at the first character. */ ! c = gfc_peek_ascii_char (); switch (c) { *************** decode_statement (void) *** 366,376 **** --- 366,378 ---- break; case 'f': + match ("final", gfc_match_final_decl, ST_FINAL); match ("flush", gfc_match_flush, ST_FLUSH); match ("format", gfc_match_format, ST_FORMAT); break; case 'g': + match ("generic", gfc_match_generic, ST_GENERIC); match ("go to", gfc_match_goto, ST_GOTO); break; *************** decode_statement (void) *** 440,445 **** --- 442,448 ---- break; case 'w': + match ("wait", gfc_match_wait, ST_WAIT); match ("write", gfc_match_write, ST_WRITE); break; } *************** static gfc_statement *** 461,467 **** decode_omp_directive (void) { locus old_locus; ! int c; #ifdef GFC_DEBUG gfc_symbol_state (); --- 464,470 ---- decode_omp_directive (void) { locus old_locus; ! char c; #ifdef GFC_DEBUG gfc_symbol_state (); *************** decode_omp_directive (void) *** 484,490 **** statement, we eliminate most possibilities by peeking at the first character. */ ! c = gfc_peek_char (); switch (c) { --- 487,493 ---- statement, we eliminate most possibilities by peeking at the first character. */ ! c = gfc_peek_ascii_char (); switch (c) { *************** decode_omp_directive (void) *** 513,518 **** --- 516,522 ---- match ("end parallel", gfc_match_omp_eos, ST_OMP_END_PARALLEL); match ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS); match ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE); + match ("end task", gfc_match_omp_eos, ST_OMP_END_TASK); match ("end workshare", gfc_match_omp_end_nowait, ST_OMP_END_WORKSHARE); break; *************** decode_omp_directive (void) *** 539,544 **** --- 543,550 ---- match ("single", gfc_match_omp_single, ST_OMP_SINGLE); break; case 't': + match ("task", gfc_match_omp_task, ST_OMP_TASK); + match ("taskwait", gfc_match_omp_taskwait, ST_OMP_TASKWAIT); match ("threadprivate", gfc_match_omp_threadprivate, ST_OMP_THREADPRIVATE); case 'w': *************** static gfc_statement *** 568,598 **** next_free (void) { match m; ! int c, d, cnt, at_bol; at_bol = gfc_at_bol (); gfc_gobble_whitespace (); ! c = gfc_peek_char (); if (ISDIGIT (c)) { /* Found a statement label? */ m = gfc_match_st_label (&gfc_statement_label); ! d = gfc_peek_char (); if (m != MATCH_YES || !gfc_is_whitespace (d)) { ! gfc_match_small_literal_int (&c, &cnt); if (cnt > 5) gfc_error_now ("Too many digits in statement label at %C"); ! if (c == 0) gfc_error_now ("Zero is not a valid statement label at %C"); do ! c = gfc_next_char (); while (ISDIGIT(c)); if (!gfc_is_whitespace (c)) --- 574,607 ---- next_free (void) { match m; ! int i, cnt, at_bol; ! char c; at_bol = gfc_at_bol (); gfc_gobble_whitespace (); ! c = gfc_peek_ascii_char (); if (ISDIGIT (c)) { + char d; + /* Found a statement label? */ m = gfc_match_st_label (&gfc_statement_label); ! d = gfc_peek_ascii_char (); if (m != MATCH_YES || !gfc_is_whitespace (d)) { ! gfc_match_small_literal_int (&i, &cnt); if (cnt > 5) gfc_error_now ("Too many digits in statement label at %C"); ! if (i == 0) gfc_error_now ("Zero is not a valid statement label at %C"); do ! c = gfc_next_ascii_char (); while (ISDIGIT(c)); if (!gfc_is_whitespace (c)) *************** next_free (void) *** 606,616 **** gfc_gobble_whitespace (); ! if (at_bol && gfc_peek_char () == ';') { gfc_error_now ("Semicolon at %C needs to be preceded by " "statement"); ! gfc_next_char (); /* Eat up the semicolon. */ return ST_NONE; } --- 615,625 ---- gfc_gobble_whitespace (); ! if (at_bol && gfc_peek_ascii_char () == ';') { gfc_error_now ("Semicolon at %C needs to be preceded by " "statement"); ! gfc_next_ascii_char (); /* Eat up the semicolon. */ return ST_NONE; } *************** next_free (void) *** 632,642 **** { int i; ! c = gfc_next_char (); ! for (i = 0; i < 5; i++, c = gfc_next_char ()) gcc_assert (c == "!$omp"[i]); ! gcc_assert (c == ' '); gfc_gobble_whitespace (); return decode_omp_directive (); } --- 641,651 ---- { int i; ! c = gfc_next_ascii_char (); ! for (i = 0; i < 5; i++, c = gfc_next_ascii_char ()) gcc_assert (c == "!$omp"[i]); ! gcc_assert (c == ' ' || c == '\t'); gfc_gobble_whitespace (); return decode_omp_directive (); } *************** next_free (void) *** 645,651 **** if (at_bol && c == ';') { gfc_error_now ("Semicolon at %C needs to be preceded by statement"); ! gfc_next_char (); /* Eat up the semicolon. */ return ST_NONE; } --- 654,660 ---- if (at_bol && c == ';') { gfc_error_now ("Semicolon at %C needs to be preceded by statement"); ! gfc_next_ascii_char (); /* Eat up the semicolon. */ return ST_NONE; } *************** next_fixed (void) *** 660,666 **** { int label, digit_flag, i; locus loc; ! char c; if (!gfc_at_bol ()) return decode_statement (); --- 669,675 ---- { int label, digit_flag, i; locus loc; ! gfc_char_t c; if (!gfc_at_bol ()) return decode_statement (); *************** next_fixed (void) *** 693,699 **** case '7': case '8': case '9': ! label = label * 10 + c - '0'; label_locus = gfc_current_locus; digit_flag = 1; break; --- 702,708 ---- case '7': case '8': case '9': ! label = label * 10 + ((unsigned char) c - '0'); label_locus = gfc_current_locus; digit_flag = 1; break; *************** next_fixed (void) *** 704,710 **** if (gfc_option.flag_openmp) { for (i = 0; i < 5; i++, c = gfc_next_char_literal (0)) ! gcc_assert (TOLOWER (c) == "*$omp"[i]); if (c != ' ' && c != '0') { --- 713,719 ---- if (gfc_option.flag_openmp) { for (i = 0; i < 5; i++, c = gfc_next_char_literal (0)) ! gcc_assert ((char) gfc_wide_tolower (c) == "*$omp"[i]); if (c != ' ' && c != '0') { *************** next_statement (void) *** 798,803 **** --- 807,813 ---- locus old_locus; gfc_new_block = NULL; + gfc_current_ns->old_cl_list = gfc_current_ns->cl_list; for (;;) { gfc_statement_label = NULL; *************** next_statement (void) *** 861,871 **** case ST_CLOSE: case ST_CONTINUE: case ST_DEALLOCATE: case ST_END_FILE: \ case ST_GOTO: case ST_INQUIRE: case ST_NULLIFY: case ST_OPEN: \ case ST_READ: case ST_RETURN: case ST_REWIND: case ST_SIMPLE_IF: \ ! case ST_PAUSE: case ST_STOP: case ST_WRITE: case ST_ASSIGNMENT: \ case ST_POINTER_ASSIGNMENT: case ST_EXIT: case ST_CYCLE: \ ! case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \ case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \ ! case ST_OMP_BARRIER /* Statements that mark other executable statements. */ --- 871,881 ---- case ST_CLOSE: case ST_CONTINUE: case ST_DEALLOCATE: case ST_END_FILE: \ case ST_GOTO: case ST_INQUIRE: case ST_NULLIFY: case ST_OPEN: \ case ST_READ: case ST_RETURN: case ST_REWIND: case ST_SIMPLE_IF: \ ! case ST_PAUSE: case ST_STOP: case ST_WAIT: case ST_WRITE: \ case ST_POINTER_ASSIGNMENT: case ST_EXIT: case ST_CYCLE: \ ! case ST_ASSIGNMENT: case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \ case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \ ! case ST_OMP_BARRIER: case ST_OMP_TASKWAIT /* Statements that mark other executable statements. */ *************** next_statement (void) *** 874,880 **** case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED: \ case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \ case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \ ! case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE /* Declaration statements */ --- 884,891 ---- case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED: \ case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \ case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \ ! case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \ ! case ST_OMP_TASK /* Declaration statements */ *************** pop_state (void) *** 914,920 **** /* Try to find the given state in the state stack. */ ! try gfc_find_state (gfc_compile_state state) { gfc_state_data *p; --- 925,931 ---- /* Try to find the given state in the state stack. */ ! gfc_try gfc_find_state (gfc_compile_state state) { gfc_state_data *p; *************** gfc_ascii_statement (gfc_statement st) *** 1186,1191 **** --- 1197,1205 ---- case ST_FUNCTION: p = "FUNCTION"; break; + case ST_GENERIC: + p = "GENERIC"; + break; case ST_GOTO: p = "GOTO"; break; *************** gfc_ascii_statement (gfc_statement st) *** 1268,1273 **** --- 1282,1290 ---- case ST_WHERE: p = "WHERE"; break; + case ST_WAIT: + p = "WAIT"; + break; case ST_WRITE: p = "WRITE"; break; *************** gfc_ascii_statement (gfc_statement st) *** 1343,1348 **** --- 1360,1368 ---- case ST_OMP_END_SINGLE: p = "!$OMP END SINGLE"; break; + case ST_OMP_END_TASK: + p = "!$OMP END TASK"; + break; case ST_OMP_END_WORKSHARE: p = "!$OMP END WORKSHARE"; break; *************** gfc_ascii_statement (gfc_statement st) *** 1376,1381 **** --- 1396,1407 ---- case ST_OMP_SINGLE: p = "!$OMP SINGLE"; break; + case ST_OMP_TASK: + p = "!$OMP TASK"; + break; + case ST_OMP_TASKWAIT: + p = "!$OMP TASKWAIT"; + break; case ST_OMP_THREADPRIVATE: p = "!$OMP THREADPRIVATE"; break; *************** accept_statement (gfc_statement st) *** 1487,1492 **** --- 1513,1522 ---- 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_new_block = NULL; gfc_undo_symbols (); gfc_clear_warning (); *************** unexpected_statement (gfc_statement st) *** 1512,1518 **** issue an error and return FAILURE. Otherwise we return SUCCESS. Individual parsers need to verify that the statements seen are ! valid before calling here, ie ENTRY statements are not allowed in INTERFACE blocks. The following diagram is taken from the standard: +---------------------------------------+ --- 1542,1548 ---- issue an error and return FAILURE. Otherwise we return SUCCESS. Individual parsers need to verify that the statements seen are ! valid before calling here, i.e., ENTRY statements are not allowed in INTERFACE blocks. The following diagram is taken from the standard: +---------------------------------------+ *************** typedef struct *** 1554,1561 **** } st_state; ! static try ! verify_st_order (st_state *p, gfc_statement st) { switch (st) --- 1584,1591 ---- } st_state; ! static gfc_try ! verify_st_order (st_state *p, gfc_statement st, bool silent) { switch (st) *************** verify_st_order (st_state *p, gfc_statem *** 1639,1647 **** return SUCCESS; order: ! gfc_error ("%s statement at %C cannot follow %s statement at %L", ! gfc_ascii_statement (st), ! gfc_ascii_statement (p->last_statement), &p->where); return FAILURE; } --- 1669,1678 ---- return SUCCESS; order: ! if (!silent) ! gfc_error ("%s statement at %C cannot follow %s statement at %L", ! gfc_ascii_statement (st), ! gfc_ascii_statement (p->last_statement), &p->where); return FAILURE; } *************** unexpected_eof (void) *** 1669,1674 **** --- 1700,1842 ---- } + /* Parse the CONTAINS section of a derived type definition. */ + + gfc_access gfc_typebound_default_access; + + static bool + parse_derived_contains (void) + { + gfc_state_data s; + bool seen_private = false; + bool seen_comps = false; + bool error_flag = false; + bool to_finish; + + gcc_assert (gfc_current_state () == COMP_DERIVED); + gcc_assert (gfc_current_block ()); + + /* Derived-types with SEQUENCE and/or BIND(C) must not have a CONTAINS + section. */ + if (gfc_current_block ()->attr.sequence) + gfc_error ("Derived-type '%s' with SEQUENCE must not have a CONTAINS" + " section at %C", gfc_current_block ()->name); + if (gfc_current_block ()->attr.is_bind_c) + gfc_error ("Derived-type '%s' with BIND(C) must not have a CONTAINS" + " section at %C", gfc_current_block ()->name); + + accept_statement (ST_CONTAINS); + push_state (&s, COMP_DERIVED_CONTAINS, NULL); + + gfc_typebound_default_access = ACCESS_PUBLIC; + + to_finish = false; + while (!to_finish) + { + gfc_statement st; + st = next_statement (); + switch (st) + { + case ST_NONE: + unexpected_eof (); + break; + + case ST_DATA_DECL: + gfc_error ("Components in TYPE at %C must precede CONTAINS"); + error_flag = true; + break; + + case ST_PROCEDURE: + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Type-bound" + " procedure at %C") == FAILURE) + error_flag = true; + + accept_statement (ST_PROCEDURE); + seen_comps = true; + break; + + case ST_GENERIC: + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: GENERIC binding" + " at %C") == FAILURE) + error_flag = true; + + accept_statement (ST_GENERIC); + seen_comps = true; + break; + + case ST_FINAL: + if (gfc_notify_std (GFC_STD_F2003, + "Fortran 2003: FINAL procedure declaration" + " at %C") == FAILURE) + error_flag = true; + + accept_statement (ST_FINAL); + seen_comps = true; + break; + + case ST_END_TYPE: + to_finish = true; + + if (!seen_comps + && (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Derived type " + "definition at %C with empty CONTAINS " + "section") == FAILURE)) + error_flag = true; + + /* ST_END_TYPE is accepted by parse_derived after return. */ + break; + + case ST_PRIVATE: + if (gfc_find_state (COMP_MODULE) == FAILURE) + { + gfc_error ("PRIVATE statement in TYPE at %C must be inside " + "a MODULE"); + error_flag = true; + break; + } + + if (seen_comps) + { + gfc_error ("PRIVATE statement at %C must precede procedure" + " bindings"); + error_flag = true; + break; + } + + if (seen_private) + { + gfc_error ("Duplicate PRIVATE statement at %C"); + error_flag = true; + } + + accept_statement (ST_PRIVATE); + gfc_typebound_default_access = ACCESS_PRIVATE; + seen_private = true; + break; + + case ST_SEQUENCE: + gfc_error ("SEQUENCE statement at %C must precede CONTAINS"); + error_flag = true; + break; + + case ST_CONTAINS: + gfc_error ("Already inside a CONTAINS block at %C"); + error_flag = true; + break; + + default: + unexpected_statement (st); + break; + } + } + + pop_state (); + gcc_assert (gfc_current_state () == COMP_DERIVED); + + return error_flag; + } + + /* Parse a derived type. */ static void *************** parse_derived (void) *** 1702,1718 **** unexpected_eof (); case ST_DATA_DECL: - case ST_PROCEDURE: accept_statement (st); seen_component = 1; break; case ST_END_TYPE: compiling_type = 0; if (!seen_component && (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Derived type " ! "definition at %C without components") == FAILURE)) error_flag = 1; --- 1870,1896 ---- unexpected_eof (); case ST_DATA_DECL: accept_statement (st); seen_component = 1; break; + case ST_PROCEDURE: + gfc_error ("PROCEDURE binding at %C must be inside CONTAINS"); + error_flag = 1; + break; + + case ST_FINAL: + gfc_error ("FINAL declaration at %C must be inside CONTAINS"); + error_flag = 1; + break; + case ST_END_TYPE: + endType: compiling_type = 0; if (!seen_component && (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Derived type " ! "definition at %C without components") == FAILURE)) error_flag = 1; *************** parse_derived (void) *** 1743,1748 **** --- 1921,1927 ---- } s.sym->component_access = ACCESS_PRIVATE; + accept_statement (ST_PRIVATE); seen_private = 1; break; *************** parse_derived (void) *** 1771,1776 **** --- 1950,1966 ---- gfc_current_block ()->name, NULL); break; + case ST_CONTAINS: + if (gfc_notify_std (GFC_STD_F2003, + "Fortran 2003: CONTAINS block in derived type" + " definition at %C") == FAILURE) + error_flag = 1; + + accept_statement (ST_CONTAINS); + if (parse_derived_contains ()) + error_flag = 1; + goto endType; + default: unexpected_statement (st); break; *************** parse_derived (void) *** 1786,1814 **** for (c = sym->components; c; c = c->next) { /* Look for allocatable components. */ ! if (c->allocatable || (c->ts.type == BT_DERIVED && c->ts.derived->attr.alloc_comp)) ! { ! sym->attr.alloc_comp = 1; ! break; ! } /* Look for pointer components. */ ! if (c->pointer || (c->ts.type == BT_DERIVED && c->ts.derived->attr.pointer_comp)) ! { ! sym->attr.pointer_comp = 1; ! break; ! } /* Look for private components. */ if (sym->component_access == ACCESS_PRIVATE ! || c->access == ACCESS_PRIVATE || (c->ts.type == BT_DERIVED && c->ts.derived->attr.private_comp)) ! { ! sym->attr.private_comp = 1; ! break; ! } } if (!seen_component) --- 1976,1995 ---- for (c = sym->components; c; c = c->next) { /* Look for allocatable components. */ ! if (c->attr.allocatable || (c->ts.type == BT_DERIVED && c->ts.derived->attr.alloc_comp)) ! sym->attr.alloc_comp = 1; /* Look for pointer components. */ ! if (c->attr.pointer || (c->ts.type == BT_DERIVED && c->ts.derived->attr.pointer_comp)) ! sym->attr.pointer_comp = 1; /* Look for private components. */ if (sym->component_access == ACCESS_PRIVATE ! || c->attr.access == ACCESS_PRIVATE || (c->ts.type == BT_DERIVED && c->ts.derived->attr.private_comp)) ! sym->attr.private_comp = 1; } if (!seen_component) *************** static gfc_statement parse_spec (gfc_sta *** 1878,1884 **** static void parse_interface (void) { ! gfc_compile_state new_state, current_state; gfc_symbol *prog_unit, *sym; gfc_interface_info save; gfc_state_data s1, s2; --- 2059,2065 ---- static void parse_interface (void) { ! gfc_compile_state new_state = COMP_NONE, current_state; gfc_symbol *prog_unit, *sym; gfc_interface_info save; gfc_state_data s1, s2; *************** loop: *** 1907,1921 **** unexpected_eof (); case ST_SUBROUTINE: - new_state = COMP_SUBROUTINE; - gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY, - gfc_new_block->formal, NULL); - break; - case ST_FUNCTION: ! new_state = COMP_FUNCTION; ! gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY, ! gfc_new_block->formal, NULL); break; case ST_PROCEDURE: --- 2088,2118 ---- unexpected_eof (); case ST_SUBROUTINE: case ST_FUNCTION: ! if (st == ST_SUBROUTINE) ! new_state = COMP_SUBROUTINE; ! else if (st == ST_FUNCTION) ! new_state = COMP_FUNCTION; ! if (gfc_new_block->attr.pointer) ! { ! gfc_new_block->attr.pointer = 0; ! gfc_new_block->attr.proc_pointer = 1; ! } ! if (gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY, ! gfc_new_block->formal, NULL) == FAILURE) ! { ! reject_statement (); ! gfc_free_namespace (gfc_current_ns); ! goto loop; ! } ! if (current_interface.type != INTERFACE_ABSTRACT && ! !gfc_new_block->attr.dummy && ! gfc_add_external (&gfc_new_block->attr, &gfc_current_locus) == FAILURE) ! { ! reject_statement (); ! gfc_free_namespace (gfc_current_ns); ! goto loop; ! } break; case ST_PROCEDURE: *************** loop: *** 1969,1975 **** if (current_interface.type == INTERFACE_ABSTRACT) { ! gfc_new_block->attr.abstract = 1; if (gfc_is_intrinsic_typename (gfc_new_block->name)) gfc_error ("Name '%s' of ABSTRACT INTERFACE at %C " "cannot be the same as an intrinsic type", --- 2166,2172 ---- if (current_interface.type == INTERFACE_ABSTRACT) { ! gfc_add_abstract (&gfc_new_block->attr, &gfc_current_locus); if (gfc_is_intrinsic_typename (gfc_new_block->name)) gfc_error ("Name '%s' of ABSTRACT INTERFACE at %C " "cannot be the same as an intrinsic type", *************** match_deferred_characteristics (gfc_type *** 2059,2066 **** /* Set the function locus correctly. If we have not found the function name, there is an error. */ ! gfc_match ("function% %n", name); ! if (m == MATCH_YES && strcmp (name, gfc_current_block ()->name) == 0) { gfc_current_block ()->declared_at = gfc_current_locus; gfc_commit_symbols (); --- 2256,2264 ---- /* Set the function locus correctly. If we have not found the function name, there is an error. */ ! if (m == MATCH_YES ! && gfc_match ("function% %n", name) == MATCH_YES ! && strcmp (name, gfc_current_block ()->name) == 0) { gfc_current_block ()->declared_at = gfc_current_locus; gfc_commit_symbols (); *************** match_deferred_characteristics (gfc_type *** 2073,2078 **** --- 2271,2296 ---- } + /* Check specification-expressions in the function result of the currently + parsed block and ensure they are typed (give an IMPLICIT type if necessary). + For return types specified in a FUNCTION prefix, the IMPLICIT rules of the + scope are not yet parsed so this has to be delayed up to parse_spec. */ + + static void + check_function_result_typed (void) + { + gfc_typespec* ts = &gfc_current_ns->proc_name->result->ts; + + gcc_assert (gfc_current_state () == COMP_FUNCTION); + gcc_assert (ts->type != BT_UNKNOWN); + + /* Check type-parameters, at the moment only CHARACTER lengths possible. */ + /* TODO: Extend when KIND type parameters are implemented. */ + if (ts->type == BT_CHARACTER && ts->cl && ts->cl->length) + gfc_expr_check_typed (ts->cl->length, gfc_current_ns, true); + } + + /* Parse a set of specification statements. Returns the statement that doesn't fit. */ *************** static gfc_statement *** 2080,2098 **** parse_spec (gfc_statement st) { st_state ss; bool bad_characteristic = false; gfc_typespec *ts; ! verify_st_order (&ss, ST_NONE); if (st == ST_NONE) st = next_statement (); loop: switch (st) { case ST_NONE: unexpected_eof (); case ST_FORMAT: case ST_ENTRY: case ST_DATA: /* Not allowed in interfaces */ --- 2298,2367 ---- parse_spec (gfc_statement st) { st_state ss; + bool function_result_typed = false; bool bad_characteristic = false; gfc_typespec *ts; ! verify_st_order (&ss, ST_NONE, false); if (st == ST_NONE) st = next_statement (); + /* If we are not inside a function or don't have a result specified so far, + do nothing special about it. */ + if (gfc_current_state () != COMP_FUNCTION) + function_result_typed = true; + else + { + gfc_symbol* proc = gfc_current_ns->proc_name; + gcc_assert (proc); + + if (proc->result->ts.type == BT_UNKNOWN) + function_result_typed = true; + } + loop: + + /* If we find a statement that can not be followed by an IMPLICIT statement + (and thus we can expect to see none any further), type the function result + if it has not yet been typed. Be careful not to give the END statement + to verify_st_order! */ + if (!function_result_typed && st != ST_GET_FCN_CHARACTERISTICS) + { + bool verify_now = false; + + if (st == ST_END_FUNCTION || st == ST_CONTAINS) + verify_now = true; + else + { + st_state dummyss; + verify_st_order (&dummyss, ST_NONE, false); + verify_st_order (&dummyss, st, false); + + if (verify_st_order (&dummyss, ST_IMPLICIT, true) == FAILURE) + verify_now = true; + } + + if (verify_now) + { + check_function_result_typed (); + function_result_typed = true; + } + } + switch (st) { case ST_NONE: unexpected_eof (); + case ST_IMPLICIT_NONE: + case ST_IMPLICIT: + if (!function_result_typed) + { + check_function_result_typed (); + function_result_typed = true; + } + goto declSt; + case ST_FORMAT: case ST_ENTRY: case ST_DATA: /* Not allowed in interfaces */ *************** loop: *** 2103,2116 **** case ST_USE: case ST_IMPORT: - case ST_IMPLICIT_NONE: - case ST_IMPLICIT: case ST_PARAMETER: case ST_PUBLIC: case ST_PRIVATE: case ST_DERIVED_DECL: case_decl: ! if (verify_st_order (&ss, st) == FAILURE) { reject_statement (); st = next_statement (); --- 2372,2384 ---- case ST_USE: case ST_IMPORT: case ST_PARAMETER: case ST_PUBLIC: case ST_PRIVATE: case ST_DERIVED_DECL: case_decl: ! declSt: ! if (verify_st_order (&ss, st, false) == FAILURE) { reject_statement (); st = next_statement (); *************** loop: *** 2199,2205 **** gfc_current_block ()->ts.kind = 0; /* Keep the derived type; if it's bad, it will be discovered later. */ if (!(ts->type == BT_DERIVED && ts->derived)) ! ts->type = BT_UNKNOWN; } return st; --- 2467,2473 ---- gfc_current_block ()->ts.kind = 0; /* Keep the derived type; if it's bad, it will be discovered later. */ if (!(ts->type == BT_DERIVED && ts->derived)) ! ts->type = BT_UNKNOWN; } return st; *************** parse_omp_structured_block (gfc_statemen *** 2779,2784 **** --- 3047,3055 ---- case ST_OMP_SINGLE: omp_end_st = ST_OMP_END_SINGLE; break; + case ST_OMP_TASK: + omp_end_st = ST_OMP_END_TASK; + break; case ST_OMP_WORKSHARE: omp_end_st = ST_OMP_END_WORKSHARE; break; *************** parse_executable (gfc_statement st) *** 2989,2994 **** --- 3260,3266 ---- case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: + case ST_OMP_TASK: parse_omp_structured_block (st, false); break; *************** parse_contained (int module) *** 3198,3205 **** pop_state (); if (!contains_statements) ! /* This is valid in Fortran 2008. */ ! gfc_notify_std (GFC_STD_GNU, "Extension: CONTAINS statement without " "FUNCTION or SUBROUTINE statement at %C"); } --- 3470,3476 ---- pop_state (); if (!contains_statements) ! gfc_notify_std (GFC_STD_F2008, "Fortran 2008: CONTAINS statement without " "FUNCTION or SUBROUTINE statement at %C"); } *************** gfc_global_used (gfc_gsymbol *sym, locus *** 3315,3321 **** name = "MODULE"; break; default: ! gfc_internal_error ("gfc_gsymbol_type(): Bad type"); name = NULL; } --- 3586,3592 ---- name = "MODULE"; break; default: ! gfc_internal_error ("gfc_global_used(): Bad type"); name = NULL; } *************** add_global_program (void) *** 3465,3471 **** /* Top level parser. */ ! try gfc_parse_file (void) { int seen_program, errors_before, errors; --- 3736,3742 ---- /* Top level parser. */ ! gfc_try gfc_parse_file (void) { int seen_program, errors_before, errors; *************** loop: *** 3564,3571 **** gfc_resolve (gfc_current_ns); /* Dump the parse tree if requested. */ ! if (gfc_option.verbose) ! gfc_show_namespace (gfc_current_ns); gfc_get_errors (NULL, &errors); if (s.state == COMP_MODULE) --- 3835,3842 ---- gfc_resolve (gfc_current_ns); /* Dump the parse tree if requested. */ ! if (gfc_option.dump_parse_tree) ! gfc_dump_parse_tree (gfc_current_ns, stdout); gfc_get_errors (NULL, &errors); if (s.state == COMP_MODULE) *************** done: *** 3590,3596 **** duplicate_main: /* If we see a duplicate main program, shut down. If the second ! instance is an implied main program, ie data decls or executable statements, we're in for lots of errors. */ gfc_error ("Two main PROGRAMs at %L and %C", &prog_locus); reject_statement (); --- 3861,3867 ---- duplicate_main: /* If we see a duplicate main program, shut down. If the second ! instance is an implied main program, i.e. data decls or executable statements, we're in for lots of errors. */ gfc_error ("Two main PROGRAMs at %L and %C", &prog_locus); reject_statement (); diff -Nrcpad gcc-4.3.3/gcc/fortran/parse.h gcc-4.4.0/gcc/fortran/parse.h *** gcc-4.3.3/gcc/fortran/parse.h Thu Jan 17 07:19:04 2008 --- gcc-4.4.0/gcc/fortran/parse.h Sun Aug 24 16:15:27 2008 *************** *** 1,5 **** /* Parser header ! Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Steven Bosscher This file is part of GCC. --- 1,6 ---- /* Parser header ! Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 ! Free Software Foundation, Inc. Contributed by Steven Bosscher This file is part of GCC. *************** along with GCC; see the file COPYING3. *** 28,35 **** typedef enum { COMP_NONE, COMP_PROGRAM, COMP_MODULE, COMP_SUBROUTINE, COMP_FUNCTION, ! COMP_BLOCK_DATA, COMP_INTERFACE, COMP_DERIVED, COMP_IF, COMP_DO, ! COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS, COMP_ENUM, COMP_OMP_STRUCTURED_BLOCK } gfc_compile_state; --- 29,36 ---- typedef enum { COMP_NONE, COMP_PROGRAM, COMP_MODULE, COMP_SUBROUTINE, COMP_FUNCTION, ! COMP_BLOCK_DATA, COMP_INTERFACE, COMP_DERIVED, COMP_DERIVED_CONTAINS, COMP_IF, ! COMP_DO, COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS, COMP_ENUM, COMP_OMP_STRUCTURED_BLOCK } gfc_compile_state; *************** extern gfc_state_data *gfc_state_stack; *** 60,66 **** #define gfc_current_state() (gfc_state_stack->state) int gfc_check_do_variable (gfc_symtree *); ! try gfc_find_state (gfc_compile_state); gfc_state_data *gfc_enclosing_unit (gfc_compile_state *); const char *gfc_ascii_statement (gfc_statement); match gfc_match_enum (void); --- 61,67 ---- #define gfc_current_state() (gfc_state_stack->state) int gfc_check_do_variable (gfc_symtree *); ! gfc_try gfc_find_state (gfc_compile_state); gfc_state_data *gfc_enclosing_unit (gfc_compile_state *); const char *gfc_ascii_statement (gfc_statement); match gfc_match_enum (void); diff -Nrcpad gcc-4.3.3/gcc/fortran/primary.c gcc-4.4.0/gcc/fortran/primary.c *** gcc-4.3.3/gcc/fortran/primary.c Sun Dec 21 15:45:52 2008 --- gcc-4.4.0/gcc/fortran/primary.c Fri Apr 3 20:56:54 2009 *************** *** 1,5 **** /* Primary expression subroutines ! Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Primary expression subroutines ! Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Andy Vaught *************** along with GCC; see the file COPYING3. *** 26,31 **** --- 26,32 ---- #include "arith.h" #include "match.h" #include "parse.h" + #include "toplev.h" /* Matches a kind-parameter expression, which is either a named symbolic constant or a nonnegative integer constant. If *************** match_kind_param (int *kind) *** 60,65 **** --- 61,68 ---- if (p != NULL) return MATCH_NO; + gfc_set_sym_referenced (sym); + if (*kind < 0) return MATCH_NO; *************** get_kind (void) *** 93,100 **** /* Given a character and a radix, see if the character is a valid digit in that radix. */ ! static int ! check_digit (int c, int radix) { int r; --- 96,103 ---- /* Given a character and a radix, see if the character is a valid digit in that radix. */ ! int ! gfc_check_digit (char c, int radix) { int r; *************** check_digit (int c, int radix) *** 117,123 **** break; default: ! gfc_internal_error ("check_digit(): bad radix"); } return r; --- 120,126 ---- break; default: ! gfc_internal_error ("gfc_check_digit(): bad radix"); } return r; *************** static int *** 133,153 **** match_digits (int signflag, int radix, char *buffer) { locus old_loc; ! int length, c; length = 0; ! c = gfc_next_char (); if (signflag && (c == '+' || c == '-')) { if (buffer != NULL) *buffer++ = c; gfc_gobble_whitespace (); ! c = gfc_next_char (); length++; } ! if (!check_digit (c, radix)) return -1; length++; --- 136,157 ---- match_digits (int signflag, int radix, char *buffer) { locus old_loc; ! int length; ! char c; length = 0; ! c = gfc_next_ascii_char (); if (signflag && (c == '+' || c == '-')) { if (buffer != NULL) *buffer++ = c; gfc_gobble_whitespace (); ! c = gfc_next_ascii_char (); length++; } ! if (!gfc_check_digit (c, radix)) return -1; length++; *************** match_digits (int signflag, int radix, c *** 157,165 **** for (;;) { old_loc = gfc_current_locus; ! c = gfc_next_char (); ! if (!check_digit (c, radix)) break; if (buffer != NULL) --- 161,169 ---- for (;;) { old_loc = gfc_current_locus; ! c = gfc_next_ascii_char (); ! if (!gfc_check_digit (c, radix)) break; if (buffer != NULL) *************** match_integer_constant (gfc_expr **resul *** 192,198 **** if (length == -1) return MATCH_NO; ! buffer = alloca (length + 1); memset (buffer, '\0', length + 1); gfc_gobble_whitespace (); --- 196,202 ---- if (length == -1) return MATCH_NO; ! buffer = (char *) alloca (length + 1); memset (buffer, '\0', length + 1); gfc_gobble_whitespace (); *************** match_hollerith_constant (gfc_expr **res *** 272,282 **** e = gfc_constant_result (BT_HOLLERITH, gfc_default_character_kind, &gfc_current_locus); ! e->representation.string = gfc_getmem (num + 1); for (i = 0; i < num; i++) { ! e->representation.string[i] = gfc_next_char_literal (1); } e->representation.string[num] = '\0'; e->representation.length = num; --- 276,296 ---- e = gfc_constant_result (BT_HOLLERITH, gfc_default_character_kind, &gfc_current_locus); ! e->representation.string = XCNEWVEC (char, num + 1); ! for (i = 0; i < num; i++) { ! gfc_char_t c = gfc_next_char_literal (1); ! if (! gfc_wide_fits_in_byte (c)) ! { ! gfc_error ("Invalid Hollerith constant at %L contains a " ! "wide character", &old_loc); ! goto cleanup; ! } ! ! e->representation.string[i] = (unsigned char) c; } + e->representation.string[num] = '\0'; e->representation.length = num; *************** cleanup: *** 304,319 **** static match match_boz_constant (gfc_expr **result) { ! int post, radix, delim, length, x_hex, kind; locus old_loc, start_loc; ! char *buffer; gfc_expr *e; start_loc = old_loc = gfc_current_locus; gfc_gobble_whitespace (); x_hex = 0; ! switch (post = gfc_next_char ()) { case 'b': radix = 2; --- 318,333 ---- static match match_boz_constant (gfc_expr **result) { ! int radix, length, x_hex, kind; locus old_loc, start_loc; ! char *buffer, post, delim; gfc_expr *e; start_loc = old_loc = gfc_current_locus; gfc_gobble_whitespace (); x_hex = 0; ! switch (post = gfc_next_ascii_char ()) { case 'b': radix = 2; *************** match_boz_constant (gfc_expr **result) *** 344,350 **** /* No whitespace allowed here. */ if (post == 0) ! delim = gfc_next_char (); if (delim != '\'' && delim != '\"') goto backup; --- 358,364 ---- /* No whitespace allowed here. */ if (post == 0) ! delim = gfc_next_ascii_char (); if (delim != '\'' && delim != '\"') goto backup; *************** match_boz_constant (gfc_expr **result) *** 364,370 **** return MATCH_ERROR; } ! if (gfc_next_char () != delim) { gfc_error ("Illegal character in BOZ constant at %C"); return MATCH_ERROR; --- 378,384 ---- return MATCH_ERROR; } ! if (gfc_next_ascii_char () != delim) { gfc_error ("Illegal character in BOZ constant at %C"); return MATCH_ERROR; *************** match_boz_constant (gfc_expr **result) *** 372,378 **** if (post == 1) { ! switch (gfc_next_char ()) { case 'b': radix = 2; --- 386,392 ---- if (post == 1) { ! switch (gfc_next_ascii_char ()) { case 'b': radix = 2; *************** match_boz_constant (gfc_expr **result) *** 397,409 **** gfc_current_locus = old_loc; ! buffer = alloca (length + 1); memset (buffer, '\0', length + 1); match_digits (0, radix, buffer); ! gfc_next_char (); /* Eat delimiter. */ if (post == 1) ! gfc_next_char (); /* Eat postfixed b, o, z, or x. */ /* In section 5.2.5 and following C567 in the Fortran 2003 standard, we find "If a data-stmt-constant is a boz-literal-constant, the corresponding --- 411,423 ---- gfc_current_locus = old_loc; ! buffer = (char *) alloca (length + 1); memset (buffer, '\0', length + 1); match_digits (0, radix, buffer); ! gfc_next_ascii_char (); /* Eat delimiter. */ if (post == 1) ! gfc_next_ascii_char (); /* Eat postfixed b, o, z, or x. */ /* In section 5.2.5 and following C567 in the Fortran 2003 standard, we find "If a data-stmt-constant is a boz-literal-constant, the corresponding *************** backup: *** 446,454 **** static match match_real_constant (gfc_expr **result, int signflag) { ! int kind, c, count, seen_dp, seen_digits, exp_char; locus old_loc, temp_loc; ! char *p, *buffer; gfc_expr *e; bool negate; --- 460,468 ---- static match match_real_constant (gfc_expr **result, int signflag) { ! int kind, count, seen_dp, seen_digits; locus old_loc, temp_loc; ! char *p, *buffer, c, exp_char; gfc_expr *e; bool negate; *************** match_real_constant (gfc_expr **result, *** 463,480 **** exp_char = ' '; negate = FALSE; ! c = gfc_next_char (); if (signflag && (c == '+' || c == '-')) { if (c == '-') negate = TRUE; gfc_gobble_whitespace (); ! c = gfc_next_char (); } /* Scan significand. */ ! for (;; c = gfc_next_char (), count++) { if (c == '.') { --- 477,494 ---- exp_char = ' '; negate = FALSE; ! c = gfc_next_ascii_char (); if (signflag && (c == '+' || c == '-')) { if (c == '-') negate = TRUE; gfc_gobble_whitespace (); ! c = gfc_next_ascii_char (); } /* Scan significand. */ ! for (;; c = gfc_next_ascii_char (), count++) { if (c == '.') { *************** match_real_constant (gfc_expr **result, *** 484,494 **** /* Check to see if "." goes with a following operator like ".eq.". */ temp_loc = gfc_current_locus; ! c = gfc_next_char (); if (c == 'e' || c == 'd' || c == 'q') { ! c = gfc_next_char (); if (c == '.') goto done; /* Operator named .e. or .d. */ } --- 498,508 ---- /* Check to see if "." goes with a following operator like ".eq.". */ temp_loc = gfc_current_locus; ! c = gfc_next_ascii_char (); if (c == 'e' || c == 'd' || c == 'q') { ! c = gfc_next_ascii_char (); if (c == '.') goto done; /* Operator named .e. or .d. */ } *************** match_real_constant (gfc_expr **result, *** 515,526 **** exp_char = c; /* Scan exponent. */ ! c = gfc_next_char (); count++; if (c == '+' || c == '-') { /* optional sign */ ! c = gfc_next_char (); count++; } --- 529,540 ---- exp_char = c; /* Scan exponent. */ ! c = gfc_next_ascii_char (); count++; if (c == '+' || c == '-') { /* optional sign */ ! c = gfc_next_ascii_char (); count++; } *************** match_real_constant (gfc_expr **result, *** 532,538 **** while (ISDIGIT (c)) { ! c = gfc_next_char (); count++; } --- 546,552 ---- while (ISDIGIT (c)) { ! c = gfc_next_ascii_char (); count++; } *************** done: *** 548,562 **** gfc_current_locus = old_loc; gfc_gobble_whitespace (); ! buffer = alloca (count + 1); memset (buffer, '\0', count + 1); p = buffer; ! c = gfc_next_char (); if (c == '+' || c == '-') { gfc_gobble_whitespace (); ! c = gfc_next_char (); } /* Hack for mpfr_set_str(). */ --- 562,576 ---- gfc_current_locus = old_loc; gfc_gobble_whitespace (); ! buffer = (char *) alloca (count + 1); memset (buffer, '\0', count + 1); p = buffer; ! c = gfc_next_ascii_char (); if (c == '+' || c == '-') { gfc_gobble_whitespace (); ! c = gfc_next_ascii_char (); } /* Hack for mpfr_set_str(). */ *************** done: *** 570,576 **** if (--count == 0) break; ! c = gfc_next_char (); } kind = get_kind (); --- 584,590 ---- if (--count == 0) break; ! c = gfc_next_ascii_char (); } kind = get_kind (); *************** cleanup: *** 722,743 **** return doubled delimiters on the input as a single instance of the delimiter. ! Special return values are: -1 End of the string, as determined by the delimiter -2 Unterminated string detected Backslash codes are also expanded at this time. */ ! static int ! next_string_char (char delimiter) { locus old_locus; ! int c; c = gfc_next_char_literal (1); if (c == '\n') ! return -2; if (gfc_option.flag_backslash && c == '\\') { --- 736,761 ---- return doubled delimiters on the input as a single instance of the delimiter. ! Special return values for "ret" argument are: -1 End of the string, as determined by the delimiter -2 Unterminated string detected Backslash codes are also expanded at this time. */ ! static gfc_char_t ! next_string_char (gfc_char_t delimiter, int *ret) { locus old_locus; ! gfc_char_t c; c = gfc_next_char_literal (1); + *ret = 0; if (c == '\n') ! { ! *ret = -2; ! return 0; ! } if (gfc_option.flag_backslash && c == '\\') { *************** next_string_char (char delimiter) *** 760,766 **** return c; gfc_current_locus = old_locus; ! return -1; } --- 778,785 ---- return c; gfc_current_locus = old_locus; ! *ret = -1; ! return 0; } *************** match_charkind_name (char *name) *** 784,790 **** int len; gfc_gobble_whitespace (); ! c = gfc_next_char (); if (!ISALPHA (c)) return MATCH_NO; --- 803,809 ---- int len; gfc_gobble_whitespace (); ! c = gfc_next_ascii_char (); if (!ISALPHA (c)) return MATCH_NO; *************** match_charkind_name (char *name) *** 794,804 **** for (;;) { old_loc = gfc_current_locus; ! c = gfc_next_char (); if (c == '_') { ! peek = gfc_peek_char (); if (peek == '\'' || peek == '\"') { --- 813,823 ---- for (;;) { old_loc = gfc_current_locus; ! c = gfc_next_ascii_char (); if (c == '_') { ! peek = gfc_peek_ascii_char (); if (peek == '\'' || peek == '\"') { *************** match_charkind_name (char *name) *** 832,844 **** static match match_string_constant (gfc_expr **result) { ! char *p, name[GFC_MAX_SYMBOL_LEN + 1]; ! int i, c, kind, length, delimiter, warn_ampersand; locus old_locus, start_locus; gfc_symbol *sym; gfc_expr *e; const char *q; match m; old_locus = gfc_current_locus; --- 851,864 ---- static match match_string_constant (gfc_expr **result) { ! char name[GFC_MAX_SYMBOL_LEN + 1], peek; ! int i, kind, length, warn_ampersand, ret; locus old_locus, start_locus; gfc_symbol *sym; gfc_expr *e; const char *q; match m; + gfc_char_t c, delimiter, *p; old_locus = gfc_current_locus; *************** match_string_constant (gfc_expr **result *** 853,863 **** goto got_delim; } ! if (ISDIGIT (c)) { kind = 0; ! while (ISDIGIT (c)) { kind = kind * 10 + c - '0'; if (kind > 9999999) --- 873,883 ---- goto got_delim; } ! if (gfc_wide_is_digit (c)) { kind = 0; ! while (gfc_wide_is_digit (c)) { kind = kind * 10 + c - '0'; if (kind > 9999999) *************** match_string_constant (gfc_expr **result *** 907,912 **** --- 927,933 ---- gfc_error (q); return MATCH_ERROR; } + gfc_set_sym_referenced (sym); } if (gfc_validate_kind (BT_CHARACTER, kind, true) < 0) *************** got_delim: *** 926,935 **** for (;;) { ! c = next_string_char (delimiter); ! if (c == -1) break; ! if (c == -2) { gfc_current_locus = start_locus; gfc_error ("Unterminated character constant beginning at %C"); --- 947,956 ---- for (;;) { ! c = next_string_char (delimiter, &ret); ! if (ret == -1) break; ! if (ret == -2) { gfc_current_locus = start_locus; gfc_error ("Unterminated character constant beginning at %C"); *************** got_delim: *** 941,948 **** /* Peek at the next character to see if it is a b, o, z, or x for the postfixed BOZ literal constants. */ ! c = gfc_peek_char (); ! if (c == 'b' || c == 'o' || c =='z' || c == 'x') goto no_match; --- 962,969 ---- /* Peek at the next character to see if it is a b, o, z, or x for the postfixed BOZ literal constants. */ ! peek = gfc_peek_ascii_char (); ! if (peek == 'b' || peek == 'o' || peek =='z' || peek == 'x') goto no_match; *************** got_delim: *** 956,962 **** e->ts.is_iso_c = 0; e->where = start_locus; ! e->value.character.string = p = gfc_getmem (length + 1); e->value.character.length = length; gfc_current_locus = start_locus; --- 977,983 ---- e->ts.is_iso_c = 0; e->where = start_locus; ! e->value.character.string = p = gfc_get_wide_string (length + 1); e->value.character.length = length; gfc_current_locus = start_locus; *************** got_delim: *** 968,979 **** gfc_option.warn_ampersand = 0; for (i = 0; i < length; i++) ! *p++ = next_string_char (delimiter); *p = '\0'; /* TODO: C-style string is for development/debug purposes. */ gfc_option.warn_ampersand = warn_ampersand; ! if (next_string_char (delimiter) != -1) gfc_internal_error ("match_string_constant(): Delimiter not found"); if (match_substring (NULL, 0, &e->ref) != MATCH_NO) --- 989,1012 ---- gfc_option.warn_ampersand = 0; for (i = 0; i < length; i++) ! { ! c = next_string_char (delimiter, &ret); ! ! if (!gfc_check_character_range (c, kind)) ! { ! gfc_error ("Character '%s' in string at %C is not representable " ! "in character kind %d", gfc_print_wide_char (c), kind); ! return MATCH_ERROR; ! } ! ! *p++ = c; ! } *p = '\0'; /* TODO: C-style string is for development/debug purposes. */ gfc_option.warn_ampersand = warn_ampersand; ! next_string_char (delimiter, &ret); ! if (ret != -1) gfc_internal_error ("match_string_constant(): Delimiter not found"); if (match_substring (NULL, 0, &e->ref) != MATCH_NO) *************** match_logical_constant_string (void) *** 997,1021 **** locus orig_loc = gfc_current_locus; gfc_gobble_whitespace (); ! if (gfc_next_char () == '.') { ! int ch = gfc_next_char(); if (ch == 'f') { ! if (gfc_next_char () == 'a' ! && gfc_next_char () == 'l' ! && gfc_next_char () == 's' ! && gfc_next_char () == 'e' ! && gfc_next_char () == '.') /* Matched ".false.". */ return 0; } else if (ch == 't') { ! if (gfc_next_char () == 'r' ! && gfc_next_char () == 'u' ! && gfc_next_char () == 'e' ! && gfc_next_char () == '.') /* Matched ".true.". */ return 1; } --- 1030,1054 ---- locus orig_loc = gfc_current_locus; gfc_gobble_whitespace (); ! if (gfc_next_ascii_char () == '.') { ! char ch = gfc_next_ascii_char (); if (ch == 'f') { ! if (gfc_next_ascii_char () == 'a' ! && gfc_next_ascii_char () == 'l' ! && gfc_next_ascii_char () == 's' ! && gfc_next_ascii_char () == 'e' ! && gfc_next_ascii_char () == '.') /* Matched ".false.". */ return 0; } else if (ch == 't') { ! if (gfc_next_ascii_char () == 'r' ! && gfc_next_ascii_char () == 'u' ! && gfc_next_ascii_char () == 'e' ! && gfc_next_ascii_char () == '.') /* Matched ".true.". */ return 1; } *************** match_complex_constant (gfc_expr **resul *** 1211,1217 **** { /* Give the matcher for implied do-loops a chance to run. This yields a much saner error message for (/ (i, 4=i, 6) /). */ ! if (gfc_peek_char () == '=') { m = MATCH_ERROR; goto cleanup; --- 1244,1250 ---- { /* Give the matcher for implied do-loops a chance to run. This yields a much saner error message for (/ (i, 4=i, 6) /). */ ! if (gfc_peek_ascii_char () == '=') { m = MATCH_ERROR; goto cleanup; *************** match_actual_arg (gfc_expr **result) *** 1325,1331 **** gfc_symtree *symtree; locus where, w; gfc_expr *e; ! int c; gfc_gobble_whitespace (); where = gfc_current_locus; --- 1358,1364 ---- gfc_symtree *symtree; locus where, w; gfc_expr *e; ! char c; gfc_gobble_whitespace (); where = gfc_current_locus; *************** match_actual_arg (gfc_expr **result) *** 1341,1347 **** case MATCH_YES: w = gfc_current_locus; gfc_gobble_whitespace (); ! c = gfc_next_char (); gfc_current_locus = w; if (c != ',' && c != ')') --- 1374,1380 ---- case MATCH_YES: w = gfc_current_locus; gfc_gobble_whitespace (); ! c = gfc_next_ascii_char (); gfc_current_locus = w; if (c != ',' && c != ')') *************** match_actual_arg (gfc_expr **result) *** 1368,1373 **** --- 1401,1413 ---- && sym->attr.flavor != FL_UNKNOWN) break; + if (sym->attr.in_common && !sym->attr.proc_pointer) + { + gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, + &sym->declared_at); + break; + } + /* If the symbol is a function with itself as the result and is being defined, then we have a variable. */ if (sym->attr.function && sym->result == sym) *************** cleanup: *** 1644,1650 **** } ! /* Used by match_varspec() to extend the reference list by one element. */ static gfc_ref * --- 1684,1690 ---- } ! /* Used by gfc_match_varspec() to extend the reference list by one element. */ static gfc_ref * *************** extend_ref (gfc_expr *primary, gfc_ref * *** 1667,1676 **** /* Match any additional specifications associated with the current variable like member references or substrings. If equiv_flag is set we only match stuff that is allowed inside an EQUIVALENCE ! statement. */ ! static match ! match_varspec (gfc_expr *primary, int equiv_flag) { char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_ref *substring, *tail; --- 1707,1717 ---- /* Match any additional specifications associated with the current variable like member references or substrings. If equiv_flag is set we only match stuff that is allowed inside an EQUIVALENCE ! statement. sub_flag tells whether we expect a type-bound procedure found ! to be a subroutine as part of CALL or a FUNCTION. */ ! match ! gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag) { char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_ref *substring, *tail; *************** match_varspec (gfc_expr *primary, int eq *** 1682,1688 **** tail = NULL; gfc_gobble_whitespace (); ! if ((equiv_flag && gfc_peek_char () == '(') || sym->attr.dimension) { /* In EQUIVALENCE, we don't know yet whether we are seeing an array, character variable or array of character --- 1723,1729 ---- tail = NULL; gfc_gobble_whitespace (); ! if ((equiv_flag && gfc_peek_ascii_char () == '(') || sym->attr.dimension) { /* In EQUIVALENCE, we don't know yet whether we are seeing an array, character variable or array of character *************** match_varspec (gfc_expr *primary, int eq *** 1696,1702 **** return m; gfc_gobble_whitespace (); ! if (equiv_flag && gfc_peek_char () == '(') { tail = extend_ref (primary, tail); tail->type = REF_ARRAY; --- 1737,1743 ---- return m; gfc_gobble_whitespace (); ! if (equiv_flag && gfc_peek_ascii_char () == '(') { tail = extend_ref (primary, tail); tail->type = REF_ARRAY; *************** match_varspec (gfc_expr *primary, int eq *** 1712,1717 **** --- 1753,1762 ---- if (equiv_flag) return MATCH_YES; + if (sym->ts.type == BT_UNKNOWN && gfc_peek_ascii_char () == '%' + && gfc_get_default_type (sym, sym->ns)->type == BT_DERIVED) + gfc_set_default_type (sym, 0, sym->ns); + if (sym->ts.type != BT_DERIVED || gfc_match_char ('%') != MATCH_YES) goto check_substring; *************** match_varspec (gfc_expr *primary, int eq *** 1719,1731 **** for (;;) { m = gfc_match_name (name); if (m == MATCH_NO) gfc_error ("Expected structure component name at %C"); if (m != MATCH_YES) return MATCH_ERROR; ! component = gfc_find_component (sym, name); if (component == NULL) return MATCH_ERROR; --- 1764,1822 ---- for (;;) { + gfc_try t; + gfc_symtree *tbp; + m = gfc_match_name (name); if (m == MATCH_NO) gfc_error ("Expected structure component name at %C"); if (m != MATCH_YES) return MATCH_ERROR; ! tbp = gfc_find_typebound_proc (sym, &t, name, false); ! if (tbp) ! { ! gfc_symbol* tbp_sym; ! ! if (t == FAILURE) ! return MATCH_ERROR; ! ! gcc_assert (!tail || !tail->next); ! gcc_assert (primary->expr_type == EXPR_VARIABLE); ! ! if (tbp->typebound->is_generic) ! tbp_sym = NULL; ! else ! tbp_sym = tbp->typebound->u.specific->n.sym; ! ! primary->expr_type = EXPR_COMPCALL; ! primary->value.compcall.tbp = tbp->typebound; ! primary->value.compcall.name = tbp->name; ! gcc_assert (primary->symtree->n.sym->attr.referenced); ! if (tbp_sym) ! primary->ts = tbp_sym->ts; ! ! m = gfc_match_actual_arglist (tbp->typebound->subroutine, ! &primary->value.compcall.actual); ! if (m == MATCH_ERROR) ! return MATCH_ERROR; ! if (m == MATCH_NO) ! { ! if (sub_flag) ! primary->value.compcall.actual = NULL; ! else ! { ! gfc_error ("Expected argument list at %C"); ! return MATCH_ERROR; ! } ! } ! ! gfc_set_sym_referenced (tbp->n.sym); ! ! break; ! } ! ! component = gfc_find_component (sym, name, false, false); if (component == NULL) return MATCH_ERROR; *************** gfc_variable_attr (gfc_expr *expr, gfc_t *** 1869,1875 **** break; case REF_COMPONENT: ! gfc_get_component_attr (&attr, ref->u.c.component); if (ts != NULL) { *ts = ref->u.c.component->ts; --- 1960,1966 ---- break; case REF_COMPONENT: ! attr = ref->u.c.component->attr; if (ts != NULL) { *ts = ref->u.c.component->ts; *************** gfc_variable_attr (gfc_expr *expr, gfc_t *** 1880,1887 **** ts->cl = NULL; } ! pointer = ref->u.c.component->pointer; ! allocatable = ref->u.c.component->allocatable; if (pointer) target = 1; --- 1971,1978 ---- ts->cl = NULL; } ! pointer = ref->u.c.component->attr.pointer; ! allocatable = ref->u.c.component->attr.allocatable; if (pointer) target = 1; *************** gfc_expr_attr (gfc_expr *e) *** 1937,2012 **** /* Match a structure constructor. The initial symbol has already been seen. */ ! match ! gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result) { ! gfc_constructor *head, *tail; ! gfc_component *comp; ! gfc_expr *e; locus where; ! match m; ! bool private_comp = false; ! head = tail = NULL; ! if (gfc_match_char ('(') != MATCH_YES) ! goto syntax; - where = gfc_current_locus; ! gfc_find_component (sym, NULL); for (comp = sym->components; comp; comp = comp->next) { ! if (comp->access == ACCESS_PRIVATE) { ! private_comp = true; ! break; } ! if (head == NULL) ! tail = head = gfc_get_constructor (); ! else { ! tail->next = gfc_get_constructor (); ! tail = tail->next; ! } ! m = gfc_match_expr (&tail->expr); ! if (m == MATCH_NO) ! goto syntax; ! if (m == MATCH_ERROR) ! goto cleanup; ! if (gfc_match_char (',') == MATCH_YES) { ! if (comp->next == NULL) { ! gfc_error ("Too many components in structure constructor at %C"); ! goto cleanup; } ! continue; } ! break; } ! if (sym->attr.use_assoc ! && (sym->component_access == ACCESS_PRIVATE || private_comp)) { ! gfc_error ("Structure constructor for '%s' at %C has PRIVATE " ! "components", sym->name); ! goto cleanup; } if (gfc_match_char (')') != MATCH_YES) ! goto syntax; ! if (comp && comp->next != NULL) { ! gfc_error ("Too few components in structure constructor at %C"); goto cleanup; } e = gfc_get_expr (); --- 2028,2312 ---- /* Match a structure constructor. The initial symbol has already been seen. */ ! typedef struct gfc_structure_ctor_component { ! char* name; ! gfc_expr* val; locus where; ! struct gfc_structure_ctor_component* next; ! } ! gfc_structure_ctor_component; ! #define gfc_get_structure_ctor_component() XCNEW (gfc_structure_ctor_component) ! static void ! gfc_free_structure_ctor_component (gfc_structure_ctor_component *comp) ! { ! gfc_free (comp->name); ! gfc_free_expr (comp->val); ! } ! /* Translate the component list into the actual constructor by sorting it in ! the order required; this also checks along the way that each and every ! component actually has an initializer and handles default initializers ! for components without explicit value given. */ ! static gfc_try ! build_actual_constructor (gfc_structure_ctor_component **comp_head, ! gfc_constructor **ctor_head, gfc_symbol *sym) ! { ! gfc_structure_ctor_component *comp_iter; ! gfc_constructor *ctor_tail = NULL; ! gfc_component *comp; for (comp = sym->components; comp; comp = comp->next) { ! gfc_structure_ctor_component **next_ptr; ! gfc_expr *value = NULL; ! ! /* Try to find the initializer for the current component by name. */ ! next_ptr = comp_head; ! for (comp_iter = *comp_head; comp_iter; comp_iter = comp_iter->next) { ! if (!strcmp (comp_iter->name, comp->name)) ! break; ! next_ptr = &comp_iter->next; } ! ! /* If an extension, try building the parent derived type by building ! a value expression for the parent derived type and calling self. */ ! if (!comp_iter && comp == sym->components && sym->attr.extension) { ! value = gfc_get_expr (); ! value->expr_type = EXPR_STRUCTURE; ! value->value.constructor = NULL; ! value->ts = comp->ts; ! value->where = gfc_current_locus; ! if (build_actual_constructor (comp_head, &value->value.constructor, ! comp->ts.derived) == FAILURE) ! { ! gfc_free_expr (value); ! return FAILURE; ! } ! *ctor_head = ctor_tail = gfc_get_constructor (); ! ctor_tail->expr = value; ! continue; ! } ! /* If it was not found, try the default initializer if there's any; ! otherwise, it's an error. */ ! if (!comp_iter) { ! if (comp->initializer) { ! if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Structure" ! " constructor with missing optional arguments" ! " at %C") == FAILURE) ! return FAILURE; ! value = gfc_copy_expr (comp->initializer); ! } ! else ! { ! gfc_error ("No initializer for component '%s' given in the" ! " structure constructor at %C!", comp->name); ! return FAILURE; } + } + else + value = comp_iter->val; ! /* Add the value to the constructor chain built. */ ! if (ctor_tail) ! { ! ctor_tail->next = gfc_get_constructor (); ! ctor_tail = ctor_tail->next; } + else + *ctor_head = ctor_tail = gfc_get_constructor (); + gcc_assert (value); + ctor_tail->expr = value; ! /* Remove the entry from the component list. We don't want the expression ! value to be free'd, so set it to NULL. */ ! if (comp_iter) ! { ! *next_ptr = comp_iter->next; ! comp_iter->val = NULL; ! gfc_free_structure_ctor_component (comp_iter); ! } } + return SUCCESS; + } ! match ! gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result, ! bool parent) ! { ! gfc_structure_ctor_component *comp_tail, *comp_head, *comp_iter; ! gfc_constructor *ctor_head, *ctor_tail; ! gfc_component *comp; /* Is set NULL when named component is first seen */ ! gfc_expr *e; ! locus where; ! match m; ! const char* last_name = NULL; ! ! comp_tail = comp_head = NULL; ! ctor_head = ctor_tail = NULL; ! ! if (!parent && gfc_match_char ('(') != MATCH_YES) ! goto syntax; ! ! where = gfc_current_locus; ! ! gfc_find_component (sym, NULL, false, true); ! ! /* Check that we're not about to construct an ABSTRACT type. */ ! if (!parent && sym->attr.abstract) { ! gfc_error ("Can't construct ABSTRACT type '%s' at %C", sym->name); ! return MATCH_ERROR; } + /* Match the component list and store it in a list together with the + corresponding component names. Check for empty argument list first. */ if (gfc_match_char (')') != MATCH_YES) ! { ! comp = sym->components; ! do ! { ! gfc_component *this_comp = NULL; ! if (!comp_head) ! comp_tail = comp_head = gfc_get_structure_ctor_component (); ! else ! { ! comp_tail->next = gfc_get_structure_ctor_component (); ! comp_tail = comp_tail->next; ! } ! comp_tail->name = XCNEWVEC (char, GFC_MAX_SYMBOL_LEN + 1); ! comp_tail->val = NULL; ! comp_tail->where = gfc_current_locus; ! ! /* Try matching a component name. */ ! if (gfc_match_name (comp_tail->name) == MATCH_YES ! && gfc_match_char ('=') == MATCH_YES) ! { ! if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Structure" ! " constructor with named arguments at %C") ! == FAILURE) ! goto cleanup; ! ! last_name = comp_tail->name; ! comp = NULL; ! } ! else ! { ! /* Components without name are not allowed after the first named ! component initializer! */ ! if (!comp) ! { ! if (last_name) ! gfc_error ("Component initializer without name after" ! " component named %s at %C!", last_name); ! else if (!parent) ! gfc_error ("Too many components in structure constructor at" ! " %C!"); ! goto cleanup; ! } ! ! gfc_current_locus = comp_tail->where; ! strncpy (comp_tail->name, comp->name, GFC_MAX_SYMBOL_LEN + 1); ! } ! ! /* Find the current component in the structure definition and check ! its access is not private. */ ! if (comp) ! this_comp = gfc_find_component (sym, comp->name, false, false); ! else ! { ! this_comp = gfc_find_component (sym, ! (const char *)comp_tail->name, ! false, false); ! comp = NULL; /* Reset needed! */ ! } ! ! /* Here we can check if a component name is given which does not ! correspond to any component of the defined structure. */ ! if (!this_comp) ! goto cleanup; ! ! /* Check if this component is already given a value. */ ! for (comp_iter = comp_head; comp_iter != comp_tail; ! comp_iter = comp_iter->next) ! { ! gcc_assert (comp_iter); ! if (!strcmp (comp_iter->name, comp_tail->name)) ! { ! gfc_error ("Component '%s' is initialized twice in the" ! " structure constructor at %C!", comp_tail->name); ! goto cleanup; ! } ! } ! ! /* Match the current initializer expression. */ ! m = gfc_match_expr (&comp_tail->val); ! if (m == MATCH_NO) ! goto syntax; ! if (m == MATCH_ERROR) ! goto cleanup; ! ! /* If not explicitly a parent constructor, gather up the components ! and build one. */ ! if (comp && comp == sym->components ! && sym->attr.extension ! && (comp_tail->val->ts.type != BT_DERIVED ! || ! comp_tail->val->ts.derived != this_comp->ts.derived)) ! { ! gfc_current_locus = where; ! gfc_free_expr (comp_tail->val); ! comp_tail->val = NULL; ! ! m = gfc_match_structure_constructor (comp->ts.derived, ! &comp_tail->val, true); ! if (m == MATCH_NO) ! goto syntax; ! if (m == MATCH_ERROR) ! goto cleanup; ! } ! ! if (comp) ! comp = comp->next; ! ! if (parent && !comp) ! break; ! } ! ! while (gfc_match_char (',') == MATCH_YES); ! ! if (!parent && gfc_match_char (')') != MATCH_YES) ! goto syntax; ! } ! ! if (build_actual_constructor (&comp_head, &ctor_head, sym) == FAILURE) ! goto cleanup; ! ! /* No component should be left, as this should have caused an error in the ! loop constructing the component-list (name that does not correspond to any ! component in the structure definition). */ ! if (comp_head && sym->attr.extension) { ! for (comp_iter = comp_head; comp_iter; comp_iter = comp_iter->next) ! { ! gfc_error ("component '%s' at %L has already been set by a " ! "parent derived type constructor", comp_iter->name, ! &comp_iter->where); ! } goto cleanup; } + else + gcc_assert (!comp_head); e = gfc_get_expr (); *************** gfc_match_structure_constructor (gfc_sym *** 2016,2022 **** e->ts.derived = sym; e->where = where; ! e->value.constructor = head; *result = e; return MATCH_YES; --- 2316,2322 ---- e->ts.derived = sym; e->where = where; ! e->value.constructor = ctor_head; *result = e; return MATCH_YES; *************** syntax: *** 2025,2031 **** gfc_error ("Syntax error in structure constructor at %C"); cleanup: ! gfc_free_constructor (head); return MATCH_ERROR; } --- 2325,2337 ---- gfc_error ("Syntax error in structure constructor at %C"); cleanup: ! for (comp_iter = comp_head; comp_iter; ) ! { ! gfc_structure_ctor_component *next = comp_iter->next; ! gfc_free_structure_ctor_component (comp_iter); ! comp_iter = next; ! } ! gfc_free_constructor (ctor_head); return MATCH_ERROR; } *************** gfc_match_rvalue (gfc_expr **result) *** 2102,2108 **** /* See if this is a directly recursive function call. */ gfc_gobble_whitespace (); if (sym->attr.recursive ! && gfc_peek_char () == '(' && gfc_current_ns->proc_name == sym && !sym->attr.dimension) { --- 2408,2414 ---- /* See if this is a directly recursive function call. */ gfc_gobble_whitespace (); if (sym->attr.recursive ! && gfc_peek_ascii_char () == '(' && gfc_current_ns->proc_name == sym && !sym->attr.dimension) { *************** gfc_match_rvalue (gfc_expr **result) *** 2130,2135 **** --- 2436,2444 ---- } } + if (gfc_matching_procptr_assignment) + goto procptr0; + if (sym->attr.function || sym->attr.external || sym->attr.intrinsic) goto function0; *************** gfc_match_rvalue (gfc_expr **result) *** 2140,2155 **** { case FL_VARIABLE: variable: - if (sym->ts.type == BT_UNKNOWN && gfc_peek_char () == '%' - && gfc_get_default_type (sym, sym->ns)->type == BT_DERIVED) - gfc_set_default_type (sym, 0, sym->ns); - e = gfc_get_expr (); e->expr_type = EXPR_VARIABLE; e->symtree = symtree; ! m = match_varspec (e, 0); break; case FL_PARAMETER: --- 2449,2460 ---- { case FL_VARIABLE: variable: e = gfc_get_expr (); e->expr_type = EXPR_VARIABLE; e->symtree = symtree; ! m = gfc_match_varspec (e, 0, false); break; case FL_PARAMETER: *************** gfc_match_rvalue (gfc_expr **result) *** 2166,2172 **** } e->symtree = symtree; ! m = match_varspec (e, 0); if (sym->ts.is_c_interop || sym->ts.is_iso_c) break; --- 2471,2477 ---- } e->symtree = symtree; ! m = gfc_match_varspec (e, 0, false); if (sym->ts.is_c_interop || sym->ts.is_iso_c) break; *************** gfc_match_rvalue (gfc_expr **result) *** 2200,2211 **** if (sym == NULL) m = MATCH_ERROR; else ! m = gfc_match_structure_constructor (sym, &e); break; /* If we're here, then the name is known to be the name of a procedure, yet it is not sure to be the name of a function. */ case FL_PROCEDURE: if (sym->attr.subroutine) { gfc_error ("Unexpected use of subroutine name '%s' at %C", --- 2505,2536 ---- if (sym == NULL) m = MATCH_ERROR; else ! m = gfc_match_structure_constructor (sym, &e, false); break; /* If we're here, then the name is known to be the name of a procedure, yet it is not sure to be the name of a function. */ case FL_PROCEDURE: + + /* Procedure Pointer Assignments. */ + procptr0: + if (gfc_matching_procptr_assignment) + { + gfc_gobble_whitespace (); + if (gfc_peek_ascii_char () == '(') + /* Parse functions returning a procptr. */ + goto function0; + + if (gfc_is_intrinsic (sym, 0, gfc_current_locus) + || gfc_is_intrinsic (sym, 1, gfc_current_locus)) + sym->attr.intrinsic = 1; + e = gfc_get_expr (); + e->expr_type = EXPR_VARIABLE; + e->symtree = symtree; + m = gfc_match_varspec (e, 0, false); + break; + } + if (sym->attr.subroutine) { gfc_error ("Unexpected use of subroutine name '%s' at %C", *************** gfc_match_rvalue (gfc_expr **result) *** 2229,2235 **** e->symtree = symtree; e->expr_type = EXPR_VARIABLE; ! m = match_varspec (e, 0); break; } --- 2554,2560 ---- e->symtree = symtree; e->expr_type = EXPR_VARIABLE; ! m = gfc_match_varspec (e, 0, false); break; } *************** gfc_match_rvalue (gfc_expr **result) *** 2305,2311 **** via an IMPLICIT statement. This can't wait for the resolution phase. */ ! if (gfc_peek_char () == '%' && sym->ts.type == BT_UNKNOWN && gfc_get_default_type (sym, sym->ns)->type == BT_DERIVED) gfc_set_default_type (sym, 0, sym->ns); --- 2630,2636 ---- via an IMPLICIT statement. This can't wait for the resolution phase. */ ! if (gfc_peek_ascii_char () == '%' && sym->ts.type == BT_UNKNOWN && gfc_get_default_type (sym, sym->ns)->type == BT_DERIVED) gfc_set_default_type (sym, 0, sym->ns); *************** gfc_match_rvalue (gfc_expr **result) *** 2325,2331 **** e = gfc_get_expr (); e->symtree = symtree; e->expr_type = EXPR_VARIABLE; ! m = match_varspec (e, 0); break; } --- 2650,2656 ---- e = gfc_get_expr (); e->symtree = symtree; e->expr_type = EXPR_VARIABLE; ! m = gfc_match_varspec (e, 0, false); break; } *************** gfc_match_rvalue (gfc_expr **result) *** 2334,2340 **** variable is just a scalar. */ gfc_gobble_whitespace (); ! if (gfc_peek_char () != '(') { /* Assume a scalar variable */ e = gfc_get_expr (); --- 2659,2665 ---- variable is just a scalar. */ gfc_gobble_whitespace (); ! if (gfc_peek_ascii_char () != '(') { /* Assume a scalar variable */ e = gfc_get_expr (); *************** gfc_match_rvalue (gfc_expr **result) *** 2348,2356 **** break; } ! /*FIXME:??? match_varspec does set this for us: */ e->ts = sym->ts; ! m = match_varspec (e, 0); break; } --- 2673,2681 ---- break; } ! /*FIXME:??? gfc_match_varspec does set this for us: */ e->ts = sym->ts; ! m = gfc_match_varspec (e, 0, false); break; } *************** gfc_match_rvalue (gfc_expr **result) *** 2439,2445 **** /* If our new function returns a character, array or structure type, it might have subsequent references. */ ! m = match_varspec (e, 0); if (m == MATCH_NO) m = MATCH_YES; --- 2764,2770 ---- /* If our new function returns a character, array or structure type, it might have subsequent references. */ ! m = gfc_match_varspec (e, 0, false); if (m == MATCH_NO) m = MATCH_YES; *************** gfc_match_rvalue (gfc_expr **result) *** 2472,2478 **** } ! /* Match a variable, ie something that can be assigned to. This starts as a symbol, can be a structure component or an array reference. It can be a function if the function doesn't have a separate RESULT variable. If the symbol has not been previously --- 2797,2803 ---- } ! /* Match a variable, i.e. something that can be assigned to. This starts as a symbol, can be a structure component or an array reference. It can be a function if the function doesn't have a separate RESULT variable. If the symbol has not been previously *************** match_variable (gfc_expr **result, int e *** 2497,2503 **** we force the changed_symbols mechanism to work by setting host_flag to 0. This prevents valid symbols that have the name of keywords, such as 'end', being turned into variables by ! failed matching to assignments for, eg., END INTERFACE. */ if (gfc_current_state () == COMP_MODULE || gfc_current_state () == COMP_INTERFACE || gfc_current_state () == COMP_CONTAINS) --- 2822,2828 ---- we force the changed_symbols mechanism to work by setting host_flag to 0. This prevents valid symbols that have the name of keywords, such as 'end', being turned into variables by ! failed matching to assignments for, e.g., END INTERFACE. */ if (gfc_current_state () == COMP_MODULE || gfc_current_state () == COMP_INTERFACE || gfc_current_state () == COMP_CONTAINS) *************** match_variable (gfc_expr **result, int e *** 2522,2528 **** switch (sym->attr.flavor) { case FL_VARIABLE: ! if (sym->attr.protected && sym->attr.use_assoc) { gfc_error ("Assigning to PROTECTED variable at %C"); return MATCH_ERROR; --- 2847,2853 ---- switch (sym->attr.flavor) { case FL_VARIABLE: ! if (sym->attr.is_protected && sym->attr.use_assoc) { gfc_error ("Assigning to PROTECTED variable at %C"); return MATCH_ERROR; *************** match_variable (gfc_expr **result, int e *** 2546,2552 **** break; /* These are definitive indicators that this is a variable. */ ! else if (gfc_peek_char () != '(' || sym->ts.type != BT_UNKNOWN || sym->attr.pointer || sym->as != NULL) flavor = FL_VARIABLE; --- 2871,2877 ---- break; /* These are definitive indicators that this is a variable. */ ! else if (gfc_peek_ascii_char () != '(' || sym->ts.type != BT_UNKNOWN || sym->attr.pointer || sym->as != NULL) flavor = FL_VARIABLE; *************** match_variable (gfc_expr **result, int e *** 2565,2572 **** break; case FL_PROCEDURE: ! /* Check for a nonrecursive function result */ ! if (sym->attr.function && sym->result == sym && !sym->attr.external) { /* If a function result is a derived type, then the derived type may still have to be resolved. */ --- 2890,2907 ---- break; case FL_PROCEDURE: ! /* Check for a nonrecursive function result variable. */ ! if (sym->attr.function ! && !sym->attr.external ! && sym->result == sym ! && ((sym == gfc_current_ns->proc_name ! && sym == gfc_current_ns->proc_name->result) ! || (gfc_current_ns->parent ! && sym == gfc_current_ns->parent->proc_name->result) ! || (sym->attr.entry ! && sym->ns == gfc_current_ns) ! || (sym->attr.entry ! && sym->ns == gfc_current_ns->parent))) { /* If a function result is a derived type, then the derived type may still have to be resolved. */ *************** match_variable (gfc_expr **result, int e *** 2577,2582 **** --- 2912,2920 ---- break; } + if (sym->attr.proc_pointer) + break; + /* Fall through to error */ default: *************** match_variable (gfc_expr **result, int e *** 2596,2602 **** else implicit_ns = sym->ns; ! if (gfc_peek_char () == '%' && sym->ts.type == BT_UNKNOWN && gfc_get_default_type (sym, implicit_ns)->type == BT_DERIVED) gfc_set_default_type (sym, 0, implicit_ns); --- 2934,2940 ---- else implicit_ns = sym->ns; ! if (gfc_peek_ascii_char () == '%' && sym->ts.type == BT_UNKNOWN && gfc_get_default_type (sym, implicit_ns)->type == BT_DERIVED) gfc_set_default_type (sym, 0, implicit_ns); *************** match_variable (gfc_expr **result, int e *** 2610,2616 **** expr->where = where; /* Now see if we have to do more. */ ! m = match_varspec (expr, equiv_flag); if (m != MATCH_YES) { gfc_free_expr (expr); --- 2948,2954 ---- expr->where = where; /* Now see if we have to do more. */ ! m = gfc_match_varspec (expr, equiv_flag, false); if (m != MATCH_YES) { gfc_free_expr (expr); diff -Nrcpad gcc-4.3.3/gcc/fortran/resolve.c gcc-4.4.0/gcc/fortran/resolve.c *** gcc-4.3.3/gcc/fortran/resolve.c Sun Jan 11 13:42:32 2009 --- gcc-4.4.0/gcc/fortran/resolve.c Fri Apr 3 20:56:54 2009 *************** *** 1,5 **** ! /* Perform type resolution on the various stuctures. ! Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- ! /* Perform type resolution on the various structures. ! Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught *************** gfc_is_formal_arg (void) *** 82,87 **** --- 82,114 ---- return formal_arg_flag; } + + /* Ensure a typespec used is valid; for instance, TYPE(t) is invalid if t is + an ABSTRACT derived-type. If where is not NULL, an error message with that + locus is printed, optionally using name. */ + + static gfc_try + resolve_typespec_used (gfc_typespec* ts, locus* where, const char* name) + { + if (ts->type == BT_DERIVED && ts->derived->attr.abstract) + { + if (where) + { + if (name) + gfc_error ("'%s' at %L is of the ABSTRACT type '%s'", + name, where, ts->derived->name); + else + gfc_error ("ABSTRACT type '%s' used at %L", + ts->derived->name, where); + } + + return FAILURE; + } + + return SUCCESS; + } + + /* Resolve types of formal argument lists. These have to be done early so that the formal argument lists of module procedures can be copied to the containing module before the individual procedures are resolved *************** resolve_formal_arglist (gfc_symbol *proc *** 106,112 **** if (gfc_elemental (proc) || sym->attr.pointer || sym->attr.allocatable || (sym->as && sym->as->rank > 0)) ! proc->attr.always_explicit = 1; formal_arg_flag = 1; --- 133,142 ---- if (gfc_elemental (proc) || sym->attr.pointer || sym->attr.allocatable || (sym->as && sym->as->rank > 0)) ! { ! proc->attr.always_explicit = 1; ! sym->attr.always_explicit = 1; ! } formal_arg_flag = 1; *************** resolve_formal_arglist (gfc_symbol *proc *** 187,193 **** if ((sym->as && sym->as->rank > 0 && sym->as->type == AS_ASSUMED_SHAPE) || sym->attr.pointer || sym->attr.allocatable || sym->attr.target || sym->attr.optional) ! proc->attr.always_explicit = 1; /* If the flavor is unknown at this point, it has to be a variable. A procedure specification would have already set the type. */ --- 217,227 ---- if ((sym->as && sym->as->rank > 0 && sym->as->type == AS_ASSUMED_SHAPE) || sym->attr.pointer || sym->attr.allocatable || sym->attr.target || sym->attr.optional) ! { ! proc->attr.always_explicit = 1; ! if (proc->result) ! proc->result->attr.always_explicit = 1; ! } /* If the flavor is unknown at this point, it has to be a variable. A procedure specification would have already set the type. */ *************** resolve_formal_arglists (gfc_namespace * *** 291,297 **** static void resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns) { ! try t; /* If this namespace is not a function or an entry master function, ignore it. */ --- 325,331 ---- static void resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns) { ! gfc_try t; /* If this namespace is not a function or an entry master function, ignore it. */ *************** has_default_initializer (gfc_symbol *der *** 641,647 **** for (c = der->components; c; c = c->next) if ((c->ts.type != BT_DERIVED && c->initializer) || (c->ts.type == BT_DERIVED ! && (!c->pointer && has_default_initializer (c->ts.derived)))) break; return c != NULL; --- 675,681 ---- for (c = der->components; c; c = c->next) if ((c->ts.type != BT_DERIVED && c->initializer) || (c->ts.type == BT_DERIVED ! && (!c->attr.pointer && has_default_initializer (c->ts.derived)))) break; return c != NULL; *************** resolve_common_vars (gfc_symbol *sym, bo *** 684,689 **** --- 718,726 ---- gfc_error_now ("Derived type variable '%s' in COMMON at %L " "may not have default initializer", csym->name, &csym->declared_at); + + if (csym->attr.flavor == FL_UNKNOWN && !csym->attr.proc_pointer) + gfc_add_flavor (&csym->attr, FL_VARIABLE, csym->name, &csym->declared_at); } } *************** resolve_contained_functions (gfc_namespa *** 760,771 **** /* Resolve all of the elements of a structure constructor and make sure that the types are correct. */ ! static try resolve_structure_cons (gfc_expr *expr) { gfc_constructor *cons; gfc_component *comp; ! try t; symbol_attribute a; t = SUCCESS; --- 797,808 ---- /* Resolve all of the elements of a structure constructor and make sure that the types are correct. */ ! static gfc_try resolve_structure_cons (gfc_expr *expr) { gfc_constructor *cons; gfc_component *comp; ! gfc_try t; symbol_attribute a; t = SUCCESS; *************** resolve_structure_cons (gfc_expr *expr) *** 803,809 **** rank = comp->as ? comp->as->rank : 0; if (cons->expr->expr_type != EXPR_NULL && rank != cons->expr->rank ! && (comp->allocatable || cons->expr->rank)) { gfc_error ("The rank of the element in the derived type " "constructor at %L does not match that of the " --- 840,846 ---- rank = comp->as ? comp->as->rank : 0; if (cons->expr->expr_type != EXPR_NULL && rank != cons->expr->rank ! && (comp->attr.allocatable || cons->expr->rank)) { gfc_error ("The rank of the element in the derived type " "constructor at %L does not match that of the " *************** resolve_structure_cons (gfc_expr *expr) *** 817,823 **** if (!gfc_compare_types (&cons->expr->ts, &comp->ts)) { t = FAILURE; ! if (comp->pointer && cons->expr->ts.type != BT_UNKNOWN) gfc_error ("The element in the derived type constructor at %L, " "for pointer component '%s', is %s but should be %s", &cons->expr->where, comp->name, --- 854,860 ---- if (!gfc_compare_types (&cons->expr->ts, &comp->ts)) { t = FAILURE; ! if (comp->attr.pointer && cons->expr->ts.type != BT_UNKNOWN) gfc_error ("The element in the derived type constructor at %L, " "for pointer component '%s', is %s but should be %s", &cons->expr->where, comp->name, *************** resolve_structure_cons (gfc_expr *expr) *** 828,834 **** } if (cons->expr->expr_type == EXPR_NULL ! && !(comp->pointer || comp->allocatable)) { t = FAILURE; gfc_error ("The NULL in the derived type constructor at %L is " --- 865,871 ---- } if (cons->expr->expr_type == EXPR_NULL ! && !(comp->attr.pointer || comp->attr.allocatable)) { t = FAILURE; gfc_error ("The NULL in the derived type constructor at %L is " *************** resolve_structure_cons (gfc_expr *expr) *** 837,843 **** comp->name); } ! if (!comp->pointer || cons->expr->expr_type == EXPR_NULL) continue; a = gfc_expr_attr (cons->expr); --- 874,880 ---- comp->name); } ! if (!comp->attr.pointer || cons->expr->expr_type == EXPR_NULL) continue; a = gfc_expr_attr (cons->expr); *************** static int need_full_assumed_size = 0; *** 957,976 **** static bool check_assumed_size_reference (gfc_symbol *sym, gfc_expr *e) { - gfc_ref *ref; - int dim; - int last = 1; - if (need_full_assumed_size || !(sym->as && sym->as->type == AS_ASSUMED_SIZE)) return false; ! for (ref = e->ref; ref; ref = ref->next) ! if (ref->type == REF_ARRAY) ! for (dim = 0; dim < ref->u.ar.as->rank; dim++) ! last = (ref->u.ar.end[dim] == NULL) ! && (ref->u.ar.type == DIMEN_ELEMENT); ! ! if (last) { gfc_error ("The upper bound in the last dimension must " "appear in the reference to the assumed size " --- 994,1007 ---- static bool check_assumed_size_reference (gfc_symbol *sym, gfc_expr *e) { if (need_full_assumed_size || !(sym->as && sym->as->type == AS_ASSUMED_SIZE)) return false; ! /* FIXME: The comparison "e->ref->u.ar.type == AR_FULL" is wrong. ! What should it be? */ ! if ((e->ref->u.ar.end[e->ref->u.ar.as->rank - 1] == NULL) ! && (e->ref->u.ar.as->type == AS_ASSUMED_SIZE) ! && (e->ref->u.ar.type == AR_FULL)) { gfc_error ("The upper bound in the last dimension must " "appear in the reference to the assumed size " *************** count_specific_procs (gfc_expr *e) *** 1044,1056 **** return n; } /* Resolve an actual argument list. Most of the time, this is just resolving the expressions in the list. The exception is that we sometimes have to decide whether arguments that look like procedure arguments are really simple variable references. */ ! static try resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, bool no_formal_args) { --- 1075,1168 ---- return n; } + + /* See if a call to sym could possibly be a not allowed RECURSION because of + a missing RECURIVE declaration. This means that either sym is the current + context itself, or sym is the parent of a contained procedure calling its + non-RECURSIVE containing procedure. + This also works if sym is an ENTRY. */ + + static bool + is_illegal_recursion (gfc_symbol* sym, gfc_namespace* context) + { + gfc_symbol* proc_sym; + gfc_symbol* context_proc; + + gcc_assert (sym->attr.flavor == FL_PROCEDURE); + + /* If we've got an ENTRY, find real procedure. */ + if (sym->attr.entry && sym->ns->entries) + proc_sym = sym->ns->entries->sym; + else + proc_sym = sym; + + /* If sym is RECURSIVE, all is well of course. */ + if (proc_sym->attr.recursive || gfc_option.flag_recursive) + return false; + + /* Find the context procdure's "real" symbol if it has entries. */ + context_proc = (context->entries ? context->entries->sym + : context->proc_name); + if (!context_proc) + return true; + + /* A call from sym's body to itself is recursion, of course. */ + if (context_proc == proc_sym) + return true; + + /* The same is true if context is a contained procedure and sym the + containing one. */ + if (context_proc->attr.contained) + { + gfc_symbol* parent_proc; + + gcc_assert (context->parent); + parent_proc = (context->parent->entries ? context->parent->entries->sym + : context->parent->proc_name); + + if (parent_proc == proc_sym) + return true; + } + + return false; + } + + + /* Resolve a procedure expression, like passing it to a called procedure or as + RHS for a procedure pointer assignment. */ + + static gfc_try + resolve_procedure_expression (gfc_expr* expr) + { + gfc_symbol* sym; + + if (expr->expr_type != EXPR_VARIABLE) + return SUCCESS; + gcc_assert (expr->symtree); + + sym = expr->symtree->n.sym; + if (sym->attr.flavor != FL_PROCEDURE + || (sym->attr.function && sym->result == sym)) + return SUCCESS; + + /* A non-RECURSIVE procedure that is used as procedure expression within its + own body is in danger of being called recursively. */ + if (is_illegal_recursion (sym, gfc_current_ns)) + gfc_warning ("Non-RECURSIVE procedure '%s' at %L is possibly calling" + " itself recursively. Declare it RECURSIVE or use" + " -frecursive", sym->name, &expr->where); + + return SUCCESS; + } + + /* Resolve an actual argument list. Most of the time, this is just resolving the expressions in the list. The exception is that we sometimes have to decide whether arguments that look like procedure arguments are really simple variable references. */ ! static gfc_try resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, bool no_formal_args) { *************** resolve_actual_arglist (gfc_actual_argli *** 1058,1064 **** gfc_symtree *parent_st; gfc_expr *e; int save_need_full_assumed_size; ! for (; arg; arg = arg->next) { e = arg->expr; --- 1170,1176 ---- gfc_symtree *parent_st; gfc_expr *e; int save_need_full_assumed_size; ! for (; arg; arg = arg->next) { e = arg->expr; *************** resolve_actual_arglist (gfc_actual_argli *** 1109,1115 **** if (!sym->attr.intrinsic && !(sym->attr.external || sym->attr.use_assoc || sym->attr.if_source == IFSRC_IFBODY) ! && gfc_intrinsic_name (sym->name, sym->attr.subroutine)) sym->attr.intrinsic = 1; if (sym->attr.proc == PROC_ST_FUNCTION) --- 1221,1227 ---- if (!sym->attr.intrinsic && !(sym->attr.external || sym->attr.use_assoc || sym->attr.if_source == IFSRC_IFBODY) ! && gfc_is_intrinsic (sym, sym->attr.subroutine, e->where)) sym->attr.intrinsic = 1; if (sym->attr.proc == PROC_ST_FUNCTION) *************** resolve_actual_arglist (gfc_actual_argli *** 1148,1162 **** /* Just in case a specific was found for the expression. */ sym = e->symtree->n.sym; - if (sym->attr.entry && sym->ns->entries - && sym->ns == gfc_current_ns - && !sym->ns->entries->sym->attr.recursive) - { - gfc_error ("Reference to ENTRY '%s' at %L is recursive, but procedure " - "'%s' is not declared as RECURSIVE", - sym->name, &e->where, sym->ns->entries->sym->name); - } - /* If the symbol is the function that names the current (or parent) scope, then we really have a variable reference. */ --- 1260,1265 ---- *************** resolve_actual_arglist (gfc_actual_argli *** 1183,1188 **** --- 1286,1294 ---- sym->attr.intrinsic = 1; sym->attr.function = 1; } + + if (gfc_resolve_expr (e) == FAILURE) + return FAILURE; goto argument_list; } *************** resolve_actual_arglist (gfc_actual_argli *** 1207,1212 **** --- 1313,1320 ---- || sym->attr.intrinsic || sym->attr.external) { + if (gfc_resolve_expr (e) == FAILURE) + return FAILURE; goto argument_list; } *************** resolve_actual_arglist (gfc_actual_argli *** 1291,1297 **** procedures. If called with c == NULL, we have a function, otherwise if expr == NULL, we have a subroutine. */ ! static try resolve_elemental_actual (gfc_expr *expr, gfc_code *c) { gfc_actual_arglist *arg0; --- 1399,1405 ---- procedures. If called with c == NULL, we have a function, otherwise if expr == NULL, we have a subroutine. */ ! static gfc_try resolve_elemental_actual (gfc_expr *expr, gfc_code *c) { gfc_actual_arglist *arg0; *************** resolve_elemental_actual (gfc_expr *expr *** 1324,1333 **** else return SUCCESS; } ! else if (c && c->ext.actual != NULL && c->symtree->n.sym->attr.elemental) { arg0 = c->ext.actual; ! esym = c->symtree->n.sym; } else return SUCCESS; --- 1432,1449 ---- else return SUCCESS; } ! else if (c && c->ext.actual != NULL) { arg0 = c->ext.actual; ! ! if (c->resolved_sym) ! esym = c->resolved_sym; ! else ! esym = c->symtree->n.sym; ! gcc_assert (esym); ! ! if (!esym->attr.elemental) ! return SUCCESS; } else return SUCCESS; *************** resolve_generic_f0 (gfc_expr *expr, gfc_ *** 1537,1543 **** } ! static try resolve_generic_f (gfc_expr *expr) { gfc_symbol *sym; --- 1653,1659 ---- } ! static gfc_try resolve_generic_f (gfc_expr *expr) { gfc_symbol *sym; *************** generic: *** 1566,1572 **** /* Last ditch attempt. See if the reference is to an intrinsic that possesses a matching interface. 14.1.2.4 */ ! if (sym && !gfc_intrinsic_name (sym->name, 0)) { gfc_error ("There is no specific function for the generic '%s' at %L", expr->symtree->n.sym->name, &expr->where); --- 1682,1688 ---- /* Last ditch attempt. See if the reference is to an intrinsic that possesses a matching interface. 14.1.2.4 */ ! if (sym && !gfc_is_intrinsic (sym, 0, expr->where)) { gfc_error ("There is no specific function for the generic '%s' at %L", expr->symtree->n.sym->name, &expr->where); *************** resolve_specific_f0 (gfc_symbol *sym, gf *** 1594,1608 **** /* See if we have an intrinsic interface. */ ! if (sym->interface != NULL && sym->interface->attr.intrinsic) { gfc_intrinsic_sym *isym; ! isym = gfc_find_function (sym->interface->name); ! /* Existance of isym should be checked already. */ gcc_assert (isym); ! sym->ts = isym->ts; sym->attr.function = 1; sym->attr.proc = PROC_EXTERNAL; goto found; --- 1710,1725 ---- /* See if we have an intrinsic interface. */ ! if (sym->ts.interface != NULL && sym->ts.interface->attr.intrinsic) { gfc_intrinsic_sym *isym; ! isym = gfc_find_function (sym->ts.interface->name); ! /* Existence of isym should be checked already. */ gcc_assert (isym); ! sym->ts.type = isym->ts.type; ! sym->ts.kind = isym->ts.kind; sym->attr.function = 1; sym->attr.proc = PROC_EXTERNAL; goto found; *************** found: *** 1652,1658 **** } ! static try resolve_specific_f (gfc_expr *expr) { gfc_symbol *sym; --- 1769,1775 ---- } ! static gfc_try resolve_specific_f (gfc_expr *expr) { gfc_symbol *sym; *************** resolve_specific_f (gfc_expr *expr) *** 1686,1692 **** /* Resolve a procedure call not known to be generic nor specific. */ ! static try resolve_unknown_f (gfc_expr *expr) { gfc_symbol *sym; --- 1803,1809 ---- /* Resolve a procedure call not known to be generic nor specific. */ ! static gfc_try resolve_unknown_f (gfc_expr *expr) { gfc_symbol *sym; *************** resolve_unknown_f (gfc_expr *expr) *** 1703,1709 **** /* See if we have an intrinsic function reference. */ ! if (gfc_intrinsic_name (sym->name, 0)) { if (gfc_intrinsic_func_interface (expr, 1) == MATCH_YES) return SUCCESS; --- 1820,1826 ---- /* See if we have an intrinsic function reference. */ ! if (gfc_is_intrinsic (sym, 0, expr->where)) { if (gfc_intrinsic_func_interface (expr, 1) == MATCH_YES) return SUCCESS; *************** is_external_proc (gfc_symbol *sym) *** 1751,1763 **** { if (!sym->attr.dummy && !sym->attr.contained && !(sym->attr.intrinsic ! || gfc_intrinsic_name (sym->name, sym->attr.subroutine)) && sym->attr.proc != PROC_ST_FUNCTION && !sym->attr.use_assoc && sym->name) return true; ! else ! return false; } --- 1868,1880 ---- { if (!sym->attr.dummy && !sym->attr.contained && !(sym->attr.intrinsic ! || gfc_is_intrinsic (sym, sym->attr.subroutine, sym->declared_at)) && sym->attr.proc != PROC_ST_FUNCTION && !sym->attr.use_assoc && sym->name) return true; ! ! return false; } *************** pure_stmt_function (gfc_expr *e, gfc_sym *** 1826,1835 **** } ! static try is_scalar_expr_ptr (gfc_expr *expr) { ! try retval = SUCCESS; gfc_ref *ref; int start; int end; --- 1943,1952 ---- } ! static gfc_try is_scalar_expr_ptr (gfc_expr *expr) { ! gfc_try retval = SUCCESS; gfc_ref *ref; int start; int end; *************** is_scalar_expr_ptr (gfc_expr *expr) *** 1927,1944 **** and, in the case of c_associated, set the binding label based on the arguments. */ ! static try gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, gfc_symbol **new_sym) { char name[GFC_MAX_SYMBOL_LEN + 1]; char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1]; ! int optional_arg = 0; ! try retval = SUCCESS; gfc_symbol *args_sym; gfc_typespec *arg_ts; - gfc_ref *parent_ref; - gfc_ref *curr_ref; if (args->expr->expr_type == EXPR_CONSTANT || args->expr->expr_type == EXPR_OP --- 2044,2059 ---- and, in the case of c_associated, set the binding label based on the arguments. */ ! static gfc_try gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, gfc_symbol **new_sym) { char name[GFC_MAX_SYMBOL_LEN + 1]; char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1]; ! int optional_arg = 0, is_pointer = 0; ! gfc_try retval = SUCCESS; gfc_symbol *args_sym; gfc_typespec *arg_ts; if (args->expr->expr_type == EXPR_CONSTANT || args->expr->expr_type == EXPR_OP *************** gfc_iso_c_func_interface (gfc_symbol *sy *** 1956,1987 **** the actual expression could be a part-ref of the expr symbol. */ arg_ts = &(args->expr->ts); ! /* Get the parent reference (if any) for the expression. This happens for ! cases such as a%b%c. */ ! parent_ref = args->expr->ref; ! curr_ref = NULL; ! if (parent_ref != NULL) ! { ! curr_ref = parent_ref->next; ! while (curr_ref != NULL && curr_ref->next != NULL) ! { ! parent_ref = curr_ref; ! curr_ref = curr_ref->next; ! } ! } ! ! /* If curr_ref is non-NULL, we had a part-ref expression. If the curr_ref ! is for a REF_COMPONENT, then we need to use it as the parent_ref for ! the name, etc. Otherwise, the current parent_ref should be correct. */ ! if (curr_ref != NULL && curr_ref->type == REF_COMPONENT) ! parent_ref = curr_ref; ! ! if (parent_ref == args->expr->ref) ! parent_ref = NULL; ! else if (parent_ref != NULL && parent_ref->type != REF_COMPONENT) ! gfc_internal_error ("Unexpected expression reference type in " ! "gfc_iso_c_func_interface"); ! if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED) { /* If the user gave two args then they are providing something for --- 2071,2078 ---- the actual expression could be a part-ref of the expr symbol. */ arg_ts = &(args->expr->ts); ! is_pointer = gfc_is_data_pointer (args->expr); ! if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED) { /* If the user gave two args then they are providing something for *************** gfc_iso_c_func_interface (gfc_symbol *sy *** 2023,2032 **** else if (sym->intmod_sym_id == ISOCBINDING_LOC) { /* Make sure we have either the target or pointer attribute. */ ! if (!(args_sym->attr.target) ! && !(args_sym->attr.pointer) ! && (parent_ref == NULL || ! !parent_ref->u.c.component->pointer)) { gfc_error_now ("Parameter '%s' to '%s' at %L must be either " "a TARGET or an associated pointer", --- 2114,2120 ---- else if (sym->intmod_sym_id == ISOCBINDING_LOC) { /* Make sure we have either the target or pointer attribute. */ ! if (!args_sym->attr.target && !is_pointer) { gfc_error_now ("Parameter '%s' to '%s' at %L must be either " "a TARGET or an associated pointer", *************** gfc_iso_c_func_interface (gfc_symbol *sy *** 2036,2045 **** } /* See if we have interoperable type and type param. */ ! if (verify_c_interop (arg_ts, ! (parent_ref ? parent_ref->u.c.component->name ! : args_sym->name), ! &(args->expr->where)) == SUCCESS || gfc_check_any_c_kind (arg_ts) == SUCCESS) { if (args_sym->attr.target == 1) --- 2124,2130 ---- } /* See if we have interoperable type and type param. */ ! if (verify_c_interop (arg_ts) == SUCCESS || gfc_check_any_c_kind (arg_ts) == SUCCESS) { if (args_sym->attr.target == 1) *************** gfc_iso_c_func_interface (gfc_symbol *sy *** 2112,2120 **** } } } ! else if ((args_sym->attr.pointer == 1 || ! (parent_ref != NULL ! && parent_ref->u.c.component->pointer)) && is_scalar_expr_ptr (args->expr) != SUCCESS) { /* Case 1c, section 15.1.2.5, J3/04-007: an associated --- 2197,2203 ---- } } } ! else if (is_pointer && is_scalar_expr_ptr (args->expr) != SUCCESS) { /* Case 1c, section 15.1.2.5, J3/04-007: an associated *************** gfc_iso_c_func_interface (gfc_symbol *sy *** 2191,2203 **** /* TODO: Check procedure arguments so that an INTENT(IN) isn't passed to INTENT(OUT) or INTENT(INOUT). */ ! static try resolve_function (gfc_expr *expr) { gfc_actual_arglist *arg; gfc_symbol *sym; const char *name; ! try t; int temp; procedure_type p = PROC_INTRINSIC; bool no_formal_args; --- 2274,2286 ---- /* TODO: Check procedure arguments so that an INTENT(IN) isn't passed to INTENT(OUT) or INTENT(INOUT). */ ! static gfc_try resolve_function (gfc_expr *expr) { gfc_actual_arglist *arg; gfc_symbol *sym; const char *name; ! gfc_try t; int temp; procedure_type p = PROC_INTRINSIC; bool no_formal_args; *************** resolve_function (gfc_expr *expr) *** 2206,2212 **** if (expr->symtree) sym = expr->symtree->n.sym; ! if (sym && sym->attr.flavor == FL_VARIABLE) { gfc_error ("'%s' at %L is not a function", sym->name, &expr->where); return FAILURE; --- 2289,2305 ---- if (expr->symtree) sym = expr->symtree->n.sym; ! if (sym && sym->attr.intrinsic ! && !gfc_find_function (sym->name) ! && gfc_find_subroutine (sym->name) ! && sym->attr.function) ! { ! gfc_error ("Intrinsic subroutine '%s' used as " ! "a function at %L", sym->name, &expr->where); ! return FAILURE; ! } ! ! if (sym && (sym->attr.flavor == FL_VARIABLE || sym->attr.subroutine)) { gfc_error ("'%s' at %L is not a function", sym->name, &expr->where); return FAILURE; *************** resolve_function (gfc_expr *expr) *** 2330,2346 **** assumed size array argument. UBOUND and SIZE have to be excluded from the check if the second argument is anything than a constant. */ - int inquiry; - inquiry = GENERIC_ID == GFC_ISYM_UBOUND - || GENERIC_ID == GFC_ISYM_SIZE; for (arg = expr->value.function.actual; arg; arg = arg->next) { ! if (inquiry && arg->next != NULL && arg->next->expr) { if (arg->next->expr->expr_type != EXPR_CONSTANT) break; if ((int)mpz_get_si (arg->next->expr->value.integer) < arg->expr->rank) break; --- 2423,2440 ---- assumed size array argument. UBOUND and SIZE have to be excluded from the check if the second argument is anything than a constant. */ for (arg = expr->value.function.actual; arg; arg = arg->next) { ! if ((GENERIC_ID == GFC_ISYM_UBOUND || GENERIC_ID == GFC_ISYM_SIZE) ! && arg->next != NULL && arg->next->expr) { if (arg->next->expr->expr_type != EXPR_CONSTANT) break; + if (arg->next->name && strncmp(arg->next->name, "kind", 4) == 0) + break; + if ((int)mpz_get_si (arg->next->expr->value.integer) < arg->expr->rank) break; *************** resolve_function (gfc_expr *expr) *** 2378,2399 **** * call themselves. */ if (expr->value.function.esym && !expr->value.function.esym->attr.recursive) { ! gfc_symbol *esym, *proc; esym = expr->value.function.esym; - proc = gfc_current_ns->proc_name; - if (esym == proc) - { - gfc_error ("Function '%s' at %L cannot call itself, as it is not " - "RECURSIVE", name, &expr->where); - t = FAILURE; - } ! if (esym->attr.entry && esym->ns->entries && proc->ns->entries ! && esym->ns->entries->sym == proc->ns->entries->sym) { ! gfc_error ("Call to ENTRY '%s' at %L is recursive, but function " ! "'%s' is not declared as RECURSIVE", ! esym->name, &expr->where, esym->ns->entries->sym->name); t = FAILURE; } } --- 2472,2490 ---- * call themselves. */ if (expr->value.function.esym && !expr->value.function.esym->attr.recursive) { ! gfc_symbol *esym; esym = expr->value.function.esym; ! if (is_illegal_recursion (esym, gfc_current_ns)) { ! if (esym->attr.entry && esym->ns->entries) ! gfc_error ("ENTRY '%s' at %L cannot be called recursively, as" ! " function '%s' is not RECURSIVE", ! esym->name, &expr->where, esym->ns->entries->sym->name); ! else ! gfc_error ("Function '%s' at %L cannot be called recursively, as it" ! " is not RECURSIVE", esym->name, &expr->where); ! t = FAILURE; } } *************** resolve_generic_s0 (gfc_code *c, gfc_sym *** 2471,2477 **** } ! static try resolve_generic_s (gfc_code *c) { gfc_symbol *sym; --- 2562,2568 ---- } ! static gfc_try resolve_generic_s (gfc_code *c) { gfc_symbol *sym; *************** generic: *** 2502,2508 **** that possesses a matching interface. 14.1.2.4 */ sym = c->symtree->n.sym; ! if (!gfc_intrinsic_name (sym->name, 1)) { gfc_error ("There is no specific subroutine for the generic '%s' at %L", sym->name, &c->loc); --- 2593,2599 ---- that possesses a matching interface. 14.1.2.4 */ sym = c->symtree->n.sym; ! if (!gfc_is_intrinsic (sym, 1, c->loc)) { gfc_error ("There is no specific subroutine for the generic '%s' at %L", sym->name, &c->loc); *************** resolve_specific_s0 (gfc_code *c, gfc_sy *** 2670,2687 **** match m; /* See if we have an intrinsic interface. */ ! if (sym->interface != NULL && !sym->interface->attr.abstract ! && !sym->interface->attr.subroutine) { gfc_intrinsic_sym *isym; ! isym = gfc_find_function (sym->interface->name); ! /* Existance of isym should be checked already. */ gcc_assert (isym); ! sym->ts = isym->ts; ! sym->attr.function = 1; goto found; } --- 2761,2780 ---- match m; /* See if we have an intrinsic interface. */ ! if (sym->ts.interface != NULL && !sym->ts.interface->attr.abstract ! && !sym->ts.interface->attr.subroutine ! && sym->ts.interface->attr.intrinsic) { gfc_intrinsic_sym *isym; ! isym = gfc_find_function (sym->ts.interface->name); ! /* Existence of isym should be checked already. */ gcc_assert (isym); ! sym->ts.type = isym->ts.type; ! sym->ts.kind = isym->ts.kind; ! sym->attr.subroutine = 1; goto found; } *************** found: *** 2730,2736 **** } ! static try resolve_specific_s (gfc_code *c) { gfc_symbol *sym; --- 2823,2829 ---- } ! static gfc_try resolve_specific_s (gfc_code *c) { gfc_symbol *sym; *************** resolve_specific_s (gfc_code *c) *** 2765,2771 **** /* Resolve a subroutine call not known to be generic nor specific. */ ! static try resolve_unknown_s (gfc_code *c) { gfc_symbol *sym; --- 2858,2864 ---- /* Resolve a subroutine call not known to be generic nor specific. */ ! static gfc_try resolve_unknown_s (gfc_code *c) { gfc_symbol *sym; *************** resolve_unknown_s (gfc_code *c) *** 2780,2786 **** /* See if we have an intrinsic function reference. */ ! if (gfc_intrinsic_name (sym->name, 1)) { if (gfc_intrinsic_sub_interface (c, 1) == MATCH_YES) return SUCCESS; --- 2873,2879 ---- /* See if we have an intrinsic function reference. */ ! if (gfc_is_intrinsic (sym, 1, c->loc)) { if (gfc_intrinsic_sub_interface (c, 1) == MATCH_YES) return SUCCESS; *************** found: *** 2804,2813 **** for functions, subroutines and functions are stored differently and this makes things awkward. */ ! static try resolve_call (gfc_code *c) { ! try t; procedure_type ptype = PROC_INTRINSIC; gfc_symbol *csym, *sym; bool no_formal_args; --- 2897,2906 ---- for functions, subroutines and functions are stored differently and this makes things awkward. */ ! static gfc_try resolve_call (gfc_code *c) { ! gfc_try t; procedure_type ptype = PROC_INTRINSIC; gfc_symbol *csym, *sym; bool no_formal_args; *************** resolve_call (gfc_code *c) *** 2823,2837 **** if (csym && gfc_current_ns->parent && csym->ns != gfc_current_ns) { ! gfc_find_symbol (csym->name, gfc_current_ns, 1, &sym); if (sym && csym != sym && sym->ns == gfc_current_ns && sym->attr.flavor == FL_PROCEDURE && sym->attr.contained) { sym->refs++; ! csym = sym; ! c->symtree->n.sym = sym; } } --- 2916,2935 ---- if (csym && gfc_current_ns->parent && csym->ns != gfc_current_ns) { ! gfc_symtree *st; ! gfc_find_sym_tree (csym->name, gfc_current_ns, 1, &st); ! sym = st ? st->n.sym : NULL; if (sym && csym != sym && sym->ns == gfc_current_ns && sym->attr.flavor == FL_PROCEDURE && sym->attr.contained) { sym->refs++; ! if (csym->attr.generic) ! c->symtree->n.sym = sym; ! else ! c->symtree = st; ! csym = c->symtree->n.sym; } } *************** resolve_call (gfc_code *c) *** 2841,2865 **** /* Subroutines without the RECURSIVE attribution are not allowed to * call themselves. */ ! if (csym && !csym->attr.recursive) { ! gfc_symbol *proc; ! proc = gfc_current_ns->proc_name; ! if (csym == proc) ! { ! gfc_error ("SUBROUTINE '%s' at %L cannot call itself, as it is not " ! "RECURSIVE", csym->name, &c->loc); ! t = FAILURE; ! } ! ! if (csym->attr.entry && csym->ns->entries && proc->ns->entries ! && csym->ns->entries->sym == proc->ns->entries->sym) ! { ! gfc_error ("Call to ENTRY '%s' at %L is recursive, but subroutine " ! "'%s' is not declared as RECURSIVE", csym->name, &c->loc, csym->ns->entries->sym->name); ! t = FAILURE; ! } } /* Switch off assumed size checking and do this again for certain kinds --- 2939,2955 ---- /* Subroutines without the RECURSIVE attribution are not allowed to * call themselves. */ ! if (csym && is_illegal_recursion (csym, gfc_current_ns)) { ! if (csym->attr.entry && csym->ns->entries) ! gfc_error ("ENTRY '%s' at %L cannot be called recursively, as" ! " subroutine '%s' is not RECURSIVE", csym->name, &c->loc, csym->ns->entries->sym->name); ! else ! gfc_error ("SUBROUTINE '%s' at %L cannot be called recursively, as it" ! " is not RECURSIVE", csym->name, &c->loc); ! ! t = FAILURE; } /* Switch off assumed size checking and do this again for certain kinds *************** resolve_call (gfc_code *c) *** 2879,2901 **** t = SUCCESS; if (c->resolved_sym == NULL) ! switch (procedure_kind (csym)) ! { ! case PTYPE_GENERIC: ! t = resolve_generic_s (c); ! break; ! case PTYPE_SPECIFIC: ! t = resolve_specific_s (c); ! break; ! case PTYPE_UNKNOWN: ! t = resolve_unknown_s (c); ! break; ! default: ! gfc_internal_error ("resolve_subroutine(): bad function type"); ! } /* Some checks of elemental subroutine actual arguments. */ if (resolve_elemental_actual (NULL, c) == FAILURE) --- 2969,2994 ---- t = SUCCESS; if (c->resolved_sym == NULL) ! { ! c->resolved_isym = NULL; ! switch (procedure_kind (csym)) ! { ! case PTYPE_GENERIC: ! t = resolve_generic_s (c); ! break; ! case PTYPE_SPECIFIC: ! t = resolve_specific_s (c); ! break; ! case PTYPE_UNKNOWN: ! t = resolve_unknown_s (c); ! break; ! default: ! gfc_internal_error ("resolve_subroutine(): bad function type"); ! } ! } /* Some checks of elemental subroutine actual arguments. */ if (resolve_elemental_actual (NULL, c) == FAILURE) *************** resolve_call (gfc_code *c) *** 2913,2922 **** if their shapes do not match. If either op1->shape or op2->shape is NULL, return SUCCESS. */ ! static try compare_shapes (gfc_expr *op1, gfc_expr *op2) { ! try t; int i; t = SUCCESS; --- 3006,3015 ---- if their shapes do not match. If either op1->shape or op2->shape is NULL, return SUCCESS. */ ! static gfc_try compare_shapes (gfc_expr *op1, gfc_expr *op2) { ! gfc_try t; int i; t = SUCCESS; *************** compare_shapes (gfc_expr *op1, gfc_expr *** 2942,2958 **** /* Resolve an operator expression node. This can involve replacing the operation with a user defined function call. */ ! static try resolve_operator (gfc_expr *e) { gfc_expr *op1, *op2; char msg[200]; bool dual_locus_error; ! try t; /* Resolve all subnodes-- give them types. */ ! switch (e->value.op.operator) { default: if (gfc_resolve_expr (e->value.op.op2) == FAILURE) --- 3035,3051 ---- /* Resolve an operator expression node. This can involve replacing the operation with a user defined function call. */ ! static gfc_try resolve_operator (gfc_expr *e) { gfc_expr *op1, *op2; char msg[200]; bool dual_locus_error; ! gfc_try t; /* Resolve all subnodes-- give them types. */ ! switch (e->value.op.op) { default: if (gfc_resolve_expr (e->value.op.op2) == FAILURE) *************** resolve_operator (gfc_expr *e) *** 2982,2988 **** goto bad_op; } ! switch (e->value.op.operator) { case INTRINSIC_UPLUS: case INTRINSIC_UMINUS: --- 3075,3081 ---- goto bad_op; } ! switch (e->value.op.op) { case INTRINSIC_UPLUS: case INTRINSIC_UMINUS: *************** resolve_operator (gfc_expr *e) *** 2995,3001 **** } sprintf (msg, _("Operand of unary numeric operator '%s' at %%L is %s"), ! gfc_op2string (e->value.op.operator), gfc_typename (&e->ts)); goto bad_op; case INTRINSIC_PLUS: --- 3088,3094 ---- } sprintf (msg, _("Operand of unary numeric operator '%s' at %%L is %s"), ! gfc_op2string (e->value.op.op), gfc_typename (&e->ts)); goto bad_op; case INTRINSIC_PLUS: *************** resolve_operator (gfc_expr *e) *** 3011,3022 **** sprintf (msg, _("Operands of binary numeric operator '%s' at %%L are %s/%s"), ! gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts), gfc_typename (&op2->ts)); goto bad_op; case INTRINSIC_CONCAT: ! if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER) { e->ts.type = BT_CHARACTER; e->ts.kind = op1->ts.kind; --- 3104,3116 ---- sprintf (msg, _("Operands of binary numeric operator '%s' at %%L are %s/%s"), ! gfc_op2string (e->value.op.op), gfc_typename (&op1->ts), gfc_typename (&op2->ts)); goto bad_op; case INTRINSIC_CONCAT: ! if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER ! && op1->ts.kind == op2->ts.kind) { e->ts.type = BT_CHARACTER; e->ts.kind = op1->ts.kind; *************** resolve_operator (gfc_expr *e) *** 3044,3050 **** } sprintf (msg, _("Operands of logical operator '%s' at %%L are %s/%s"), ! gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts), gfc_typename (&op2->ts)); goto bad_op; --- 3138,3144 ---- } 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)); goto bad_op; *************** resolve_operator (gfc_expr *e) *** 3081,3087 **** case INTRINSIC_EQ_OS: case INTRINSIC_NE: case INTRINSIC_NE_OS: ! if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER) { e->ts.type = BT_LOGICAL; e->ts.kind = gfc_default_logical_kind; --- 3175,3182 ---- case INTRINSIC_EQ_OS: case INTRINSIC_NE: case INTRINSIC_NE_OS: ! if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER ! && op1->ts.kind == op2->ts.kind) { e->ts.type = BT_LOGICAL; e->ts.kind = gfc_default_logical_kind; *************** resolve_operator (gfc_expr *e) *** 3100,3118 **** if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL) sprintf (msg, _("Logicals at %%L must be compared with %s instead of %s"), ! (e->value.op.operator == INTRINSIC_EQ ! || e->value.op.operator == INTRINSIC_EQ_OS) ! ? ".eqv." : ".neqv.", gfc_op2string (e->value.op.operator)); else sprintf (msg, _("Operands of comparison operator '%s' at %%L are %s/%s"), ! gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts), gfc_typename (&op2->ts)); goto bad_op; case INTRINSIC_USER: ! if (e->value.op.uop->operator == NULL) sprintf (msg, _("Unknown operator '%s' at %%L"), e->value.op.uop->name); else if (op2 == NULL) sprintf (msg, _("Operand of user operator '%s' at %%L is %s"), --- 3195,3213 ---- if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL) sprintf (msg, _("Logicals at %%L must be compared with %s instead of %s"), ! (e->value.op.op == INTRINSIC_EQ ! || e->value.op.op == INTRINSIC_EQ_OS) ! ? ".eqv." : ".neqv.", gfc_op2string (e->value.op.op)); else sprintf (msg, _("Operands of comparison operator '%s' at %%L are %s/%s"), ! gfc_op2string (e->value.op.op), gfc_typename (&op1->ts), gfc_typename (&op2->ts)); goto bad_op; case INTRINSIC_USER: ! if (e->value.op.uop->op == NULL) sprintf (msg, _("Unknown operator '%s' at %%L"), e->value.op.uop->name); else if (op2 == NULL) sprintf (msg, _("Operand of user operator '%s' at %%L is %s"), *************** resolve_operator (gfc_expr *e) *** 3138,3144 **** t = SUCCESS; ! switch (e->value.op.operator) { case INTRINSIC_PLUS: case INTRINSIC_MINUS: --- 3233,3239 ---- t = SUCCESS; ! switch (e->value.op.op) { case INTRINSIC_PLUS: case INTRINSIC_MINUS: *************** resolve_operator (gfc_expr *e) *** 3232,3238 **** { t = gfc_simplify_expr (e, 0); /* Some calls do not succeed in simplification and return FAILURE ! even though there is no error; eg. variable references to PARAMETER arrays. */ if (!gfc_is_constant_expr (e)) t = SUCCESS; --- 3327,3333 ---- { t = gfc_simplify_expr (e, 0); /* Some calls do not succeed in simplification and return FAILURE ! even though there is no error; e.g. variable references to PARAMETER arrays. */ if (!gfc_is_constant_expr (e)) t = SUCCESS; *************** compute_last_value_for_triplet (gfc_expr *** 3385,3391 **** /* Compare a single dimension of an array reference to the array specification. */ ! static try check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) { mpz_t last_value; --- 3480,3486 ---- /* Compare a single dimension of an array reference to the array specification. */ ! static gfc_try check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) { mpz_t last_value; *************** check_dimension (int i, gfc_array_ref *a *** 3503,3509 **** /* Compare an array reference with an array specification. */ ! static try compare_spec_to_ref (gfc_array_ref *ar) { gfc_array_spec *as; --- 3598,3604 ---- /* Compare an array reference with an array specification. */ ! static gfc_try compare_spec_to_ref (gfc_array_ref *ar) { gfc_array_spec *as; *************** compare_spec_to_ref (gfc_array_ref *ar) *** 3542,3548 **** /* Resolve one part of an array index. */ ! try gfc_resolve_index (gfc_expr *index, int check_scalar) { gfc_typespec ts; --- 3637,3643 ---- /* Resolve one part of an array index. */ ! gfc_try gfc_resolve_index (gfc_expr *index, int check_scalar) { gfc_typespec ts; *************** gfc_resolve_index (gfc_expr *index, int *** 3561,3568 **** if (index->ts.type != BT_INTEGER && index->ts.type != BT_REAL) { ! gfc_error ("Array index at %L must be of INTEGER type", ! &index->where); return FAILURE; } --- 3656,3663 ---- if (index->ts.type != BT_INTEGER && index->ts.type != BT_REAL) { ! gfc_error ("Array index at %L must be of INTEGER type, found %s", ! &index->where, gfc_basic_typename (index->ts.type)); return FAILURE; } *************** gfc_resolve_index (gfc_expr *index, int *** 3586,3592 **** /* Resolve a dim argument to an intrinsic function. */ ! try gfc_resolve_dim_arg (gfc_expr *dim) { if (dim == NULL) --- 3681,3687 ---- /* Resolve a dim argument to an intrinsic function. */ ! gfc_try gfc_resolve_dim_arg (gfc_expr *dim) { if (dim == NULL) *************** find_array_spec (gfc_expr *e) *** 3671,3677 **** if (c == NULL) gfc_internal_error ("find_array_spec(): Component not found"); ! if (c->dimension) { if (as != NULL) gfc_internal_error ("find_array_spec(): unused as(1)"); --- 3766,3772 ---- if (c == NULL) gfc_internal_error ("find_array_spec(): Component not found"); ! if (c->attr.dimension) { if (as != NULL) gfc_internal_error ("find_array_spec(): unused as(1)"); *************** find_array_spec (gfc_expr *e) *** 3691,3697 **** /* Resolve an array reference. */ ! static try resolve_array_ref (gfc_array_ref *ar) { int i, check_scalar; --- 3786,3792 ---- /* Resolve an array reference. */ ! static gfc_try resolve_array_ref (gfc_array_ref *ar) { int i, check_scalar; *************** resolve_array_ref (gfc_array_ref *ar) *** 3752,3758 **** } ! static try resolve_substring (gfc_ref *ref) { if (ref->u.ss.start != NULL) --- 3847,3853 ---- } ! static gfc_try resolve_substring (gfc_ref *ref) { if (ref->u.ss.start != NULL) *************** gfc_resolve_substring_charlen (gfc_expr *** 3884,3890 **** /* Resolve subtype references. */ ! static try resolve_ref (gfc_expr *expr) { int current_part_dimension, n_components, seen_part_dimension; --- 3979,3985 ---- /* Resolve subtype references. */ ! static gfc_try resolve_ref (gfc_expr *expr) { int current_part_dimension, n_components, seen_part_dimension; *************** resolve_ref (gfc_expr *expr) *** 3944,3957 **** case REF_COMPONENT: if (current_part_dimension || seen_part_dimension) { ! if (ref->u.c.component->pointer) { gfc_error ("Component to the right of a part reference " "with nonzero rank must not have the POINTER " "attribute at %L", &expr->where); return FAILURE; } ! else if (ref->u.c.component->allocatable) { gfc_error ("Component to the right of a part reference " "with nonzero rank must not have the ALLOCATABLE " --- 4039,4052 ---- case REF_COMPONENT: if (current_part_dimension || seen_part_dimension) { ! if (ref->u.c.component->attr.pointer) { gfc_error ("Component to the right of a part reference " "with nonzero rank must not have the POINTER " "attribute at %L", &expr->where); return FAILURE; } ! else if (ref->u.c.component->attr.allocatable) { gfc_error ("Component to the right of a part reference " "with nonzero rank must not have the ALLOCATABLE " *************** expression_rank (gfc_expr *e) *** 4028,4033 **** --- 4123,4132 ---- gfc_ref *ref; int i, rank; + /* Just to make sure, because EXPR_COMPCALL's also have an e->ref and that + could lead to serious confusion... */ + gcc_assert (e->expr_type != EXPR_COMPCALL); + if (e->ref == NULL) { if (e->expr_type == EXPR_ARRAY) *************** done: *** 4082,4092 **** /* Resolve a variable expression. */ ! static try resolve_variable (gfc_expr *e) { gfc_symbol *sym; ! try t; t = SUCCESS; --- 4181,4191 ---- /* Resolve a variable expression. */ ! static gfc_try resolve_variable (gfc_expr *e) { gfc_symbol *sym; ! gfc_try t; t = SUCCESS; *************** resolve_variable (gfc_expr *e) *** 4100,4106 **** if (sym->attr.flavor == FL_PROCEDURE && !sym->attr.function) { e->ts.type = BT_PROCEDURE; ! return SUCCESS; } if (sym->ts.type != BT_UNKNOWN) --- 4199,4205 ---- if (sym->attr.flavor == FL_PROCEDURE && !sym->attr.function) { e->ts.type = BT_PROCEDURE; ! goto resolve_procedure; } if (sym->ts.type != BT_UNKNOWN) *************** resolve_variable (gfc_expr *e) *** 4182,4187 **** --- 4281,4290 ---- sym->entry_id = current_entry_id + 1; } + resolve_procedure: + if (t == SUCCESS && resolve_procedure_expression (e) == FAILURE) + t = FAILURE; + return t; } *************** resolve_variable (gfc_expr *e) *** 4189,4203 **** /* Checks to see that the correct symbol has been host associated. The only situation where this arises is that in which a twice contained function is parsed after the host association is made. ! Therefore, on detecting this, the line is rematched, having got ! rid of the existing references and actual_arg_list. */ static bool check_host_association (gfc_expr *e) { gfc_symbol *sym, *old_sym; ! locus temp_locus; ! gfc_expr *expr; int n; bool retval = e->expr_type == EXPR_FUNCTION; /* If the expression is the result of substitution in --- 4292,4308 ---- /* Checks to see that the correct symbol has been host associated. The only situation where this arises is that in which a twice contained function is parsed after the host association is made. ! Therefore, on detecting this, change the symbol in the expression ! and convert the array reference into an actual arglist if the old ! symbol is a variable. */ static bool check_host_association (gfc_expr *e) { gfc_symbol *sym, *old_sym; ! gfc_symtree *st; int n; + gfc_ref *ref; + gfc_actual_arglist *arg, *tail; bool retval = e->expr_type == EXPR_FUNCTION; /* If the expression is the result of substitution in *************** check_host_association (gfc_expr *e) *** 4213,4238 **** if (gfc_current_ns->parent && old_sym->ns != gfc_current_ns) { gfc_find_symbol (e->symtree->name, gfc_current_ns, 1, &sym); if (sym && old_sym != sym && sym->ts.type == old_sym->ts.type && sym->attr.flavor == FL_PROCEDURE && sym->attr.contained) { ! temp_locus = gfc_current_locus; ! gfc_current_locus = e->where; ! ! gfc_buffer_error (1); ! ! gfc_free_ref_list (e->ref); ! e->ref = NULL; ! ! if (retval) ! { ! gfc_free_actual_arglist (e->value.function.actual); ! e->value.function.actual = NULL; ! } ! if (e->shape != NULL) { for (n = 0; n < e->rank; n++) --- 4318,4333 ---- if (gfc_current_ns->parent && old_sym->ns != gfc_current_ns) { + /* Use the 'USE' name so that renamed module symbols are + correctly handled. */ gfc_find_symbol (e->symtree->name, gfc_current_ns, 1, &sym); + if (sym && old_sym != sym && sym->ts.type == old_sym->ts.type && sym->attr.flavor == FL_PROCEDURE && sym->attr.contained) { ! /* Clear the shape, since it might not be valid. */ if (e->shape != NULL) { for (n = 0; n < e->rank; n++) *************** check_host_association (gfc_expr *e) *** 4241,4262 **** gfc_free (e->shape); } ! /* TODO - Replace this gfc_match_rvalue with a straight replacement of ! actual arglists for function to function substitutions and with a ! conversion of the reference list to an actual arglist in the case of ! a variable to function replacement. This should be quite easy since ! only integers and vectors can be involved. */ ! gfc_match_rvalue (&expr); ! gfc_clear_error (); ! gfc_buffer_error (0); ! gcc_assert (expr && sym == expr->symtree->n.sym); ! *e = *expr; ! gfc_free (expr); ! sym->refs++; ! gfc_current_locus = temp_locus; } } /* This might have changed! */ --- 4336,4393 ---- gfc_free (e->shape); } ! /* Give the symbol a symtree in the right place! */ ! gfc_get_sym_tree (sym->name, gfc_current_ns, &st); ! st->n.sym = sym; ! if (old_sym->attr.flavor == FL_PROCEDURE) ! { ! /* Original was function so point to the new symbol, since ! the actual argument list is already attached to the ! expression. */ ! e->value.function.esym = NULL; ! e->symtree = st; ! } ! else ! { ! /* Original was variable so convert array references into ! an actual arglist. This does not need any checking now ! since gfc_resolve_function will take care of it. */ ! e->value.function.actual = NULL; ! e->expr_type = EXPR_FUNCTION; ! e->symtree = st; ! /* Ambiguity will not arise if the array reference is not ! the last reference. */ ! for (ref = e->ref; ref; ref = ref->next) ! if (ref->type == REF_ARRAY && ref->next == NULL) ! break; ! gcc_assert (ref->type == REF_ARRAY); ! ! /* Grab the start expressions from the array ref and ! copy them into actual arguments. */ ! for (n = 0; n < ref->u.ar.dimen; n++) ! { ! arg = gfc_get_actual_arglist (); ! arg->expr = gfc_copy_expr (ref->u.ar.start[n]); ! if (e->value.function.actual == NULL) ! tail = e->value.function.actual = arg; ! else ! { ! tail->next = arg; ! tail = arg; ! } ! } ! ! /* Dump the reference list and set the rank. */ ! gfc_free_ref_list (e->ref); ! e->ref = NULL; ! e->rank = sym->as ? sym->as->rank : 0; ! } ! ! gfc_resolve_expr (e); ! sym->refs++; } } /* This might have changed! */ *************** gfc_resolve_character_operator (gfc_expr *** 4272,4278 **** gfc_expr *e1 = NULL; gfc_expr *e2 = NULL; ! gcc_assert (e->value.op.operator == INTRINSIC_CONCAT); if (op1->ts.cl && op1->ts.cl->length) e1 = gfc_copy_expr (op1->ts.cl->length); --- 4403,4409 ---- gfc_expr *e1 = NULL; gfc_expr *e2 = NULL; ! gcc_assert (e->value.op.op == INTRINSIC_CONCAT); if (op1->ts.cl && op1->ts.cl->length) e1 = gfc_copy_expr (op1->ts.cl->length); *************** fixup_charlen (gfc_expr *e) *** 4336,4349 **** } /* 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. */ ! try gfc_resolve_expr (gfc_expr *e) { ! try t; if (e == NULL) return SUCCESS; --- 4467,4745 ---- } + /* Update an actual argument to include the passed-object for type-bound + procedures at the right position. */ + + static gfc_actual_arglist* + update_arglist_pass (gfc_actual_arglist* lst, gfc_expr* po, unsigned argpos) + { + gcc_assert (argpos > 0); + + if (argpos == 1) + { + gfc_actual_arglist* result; + + result = gfc_get_actual_arglist (); + result->expr = po; + result->next = lst; + + return result; + } + + gcc_assert (lst); + gcc_assert (argpos > 1); + + lst->next = update_arglist_pass (lst->next, po, argpos - 1); + return lst; + } + + + /* Extract the passed-object from an EXPR_COMPCALL (a copy of it). */ + + static gfc_expr* + extract_compcall_passed_object (gfc_expr* e) + { + gfc_expr* po; + + gcc_assert (e->expr_type == EXPR_COMPCALL); + + po = gfc_get_expr (); + po->expr_type = EXPR_VARIABLE; + po->symtree = e->symtree; + po->ref = gfc_copy_ref (e->ref); + + if (gfc_resolve_expr (po) == FAILURE) + return NULL; + + return po; + } + + + /* Update the arglist of an EXPR_COMPCALL expression to include the + passed-object. */ + + static gfc_try + update_compcall_arglist (gfc_expr* e) + { + gfc_expr* po; + gfc_typebound_proc* tbp; + + tbp = e->value.compcall.tbp; + + if (tbp->error) + return FAILURE; + + po = extract_compcall_passed_object (e); + if (!po) + return FAILURE; + + if (po->rank > 0) + { + gfc_error ("Passed-object at %L must be scalar", &e->where); + return FAILURE; + } + + if (tbp->nopass) + { + gfc_free_expr (po); + return SUCCESS; + } + + gcc_assert (tbp->pass_arg_num > 0); + e->value.compcall.actual = update_arglist_pass (e->value.compcall.actual, po, + tbp->pass_arg_num); + + return SUCCESS; + } + + + /* Resolve a call to a type-bound procedure, either function or subroutine, + statically from the data in an EXPR_COMPCALL expression. The adapted + arglist and the target-procedure symtree are returned. */ + + static gfc_try + resolve_typebound_static (gfc_expr* e, gfc_symtree** target, + gfc_actual_arglist** actual) + { + gcc_assert (e->expr_type == EXPR_COMPCALL); + gcc_assert (!e->value.compcall.tbp->is_generic); + + /* Update the actual arglist for PASS. */ + if (update_compcall_arglist (e) == FAILURE) + return FAILURE; + + *actual = e->value.compcall.actual; + *target = e->value.compcall.tbp->u.specific; + + gfc_free_ref_list (e->ref); + e->ref = NULL; + e->value.compcall.actual = NULL; + + return SUCCESS; + } + + + /* Given an EXPR_COMPCALL calling a GENERIC typebound procedure, figure out + which of the specific bindings (if any) matches the arglist and transform + the expression into a call of that binding. */ + + static gfc_try + resolve_typebound_generic_call (gfc_expr* e) + { + gfc_typebound_proc* genproc; + const char* genname; + + gcc_assert (e->expr_type == EXPR_COMPCALL); + genname = e->value.compcall.name; + genproc = e->value.compcall.tbp; + + if (!genproc->is_generic) + return SUCCESS; + + /* Try the bindings on this type and in the inheritance hierarchy. */ + for (; genproc; genproc = genproc->overridden) + { + gfc_tbp_generic* g; + + gcc_assert (genproc->is_generic); + for (g = genproc->u.generic; g; g = g->next) + { + gfc_symbol* target; + gfc_actual_arglist* args; + bool matches; + + gcc_assert (g->specific); + + if (g->specific->error) + continue; + + target = g->specific->u.specific->n.sym; + + /* Get the right arglist by handling PASS/NOPASS. */ + args = gfc_copy_actual_arglist (e->value.compcall.actual); + if (!g->specific->nopass) + { + gfc_expr* po; + po = extract_compcall_passed_object (e); + if (!po) + return FAILURE; + + gcc_assert (g->specific->pass_arg_num > 0); + gcc_assert (!g->specific->error); + args = update_arglist_pass (args, po, g->specific->pass_arg_num); + } + resolve_actual_arglist (args, target->attr.proc, + is_external_proc (target) && !target->formal); + + /* Check if this arglist matches the formal. */ + matches = gfc_arglist_matches_symbol (&args, target); + + /* Clean up and break out of the loop if we've found it. */ + gfc_free_actual_arglist (args); + if (matches) + { + e->value.compcall.tbp = g->specific; + goto success; + } + } + } + + /* Nothing matching found! */ + gfc_error ("Found no matching specific binding for the call to the GENERIC" + " '%s' at %L", genname, &e->where); + return FAILURE; + + success: + return SUCCESS; + } + + + /* Resolve a call to a type-bound subroutine. */ + + static gfc_try + resolve_typebound_call (gfc_code* c) + { + gfc_actual_arglist* newactual; + gfc_symtree* target; + + /* Check that's really a SUBROUTINE. */ + if (!c->expr->value.compcall.tbp->subroutine) + { + gfc_error ("'%s' at %L should be a SUBROUTINE", + c->expr->value.compcall.name, &c->loc); + return FAILURE; + } + + if (resolve_typebound_generic_call (c->expr) == FAILURE) + return FAILURE; + + /* Transform into an ordinary EXEC_CALL for now. */ + + if (resolve_typebound_static (c->expr, &target, &newactual) == FAILURE) + return FAILURE; + + c->ext.actual = newactual; + c->symtree = target; + c->op = EXEC_CALL; + + gcc_assert (!c->expr->ref && !c->expr->value.compcall.actual); + gfc_free_expr (c->expr); + c->expr = NULL; + + return resolve_call (c); + } + + + /* Resolve a component-call expression. */ + + static gfc_try + resolve_compcall (gfc_expr* e) + { + gfc_actual_arglist* newactual; + gfc_symtree* target; + + /* Check that's really a FUNCTION. */ + if (!e->value.compcall.tbp->function) + { + gfc_error ("'%s' at %L should be a FUNCTION", + e->value.compcall.name, &e->where); + return FAILURE; + } + + if (resolve_typebound_generic_call (e) == FAILURE) + return FAILURE; + gcc_assert (!e->value.compcall.tbp->is_generic); + + /* Take the rank from the function's symbol. */ + if (e->value.compcall.tbp->u.specific->n.sym->as) + e->rank = e->value.compcall.tbp->u.specific->n.sym->as->rank; + + /* For now, we simply transform it into an EXPR_FUNCTION call with the same + arglist to the TBP's binding target. */ + + if (resolve_typebound_static (e, &target, &newactual) == FAILURE) + return FAILURE; + + e->value.function.actual = newactual; + e->value.function.name = e->value.compcall.name; + e->value.function.isym = NULL; + e->value.function.esym = NULL; + e->symtree = target; + e->ts = target->n.sym->ts; + e->expr_type = EXPR_FUNCTION; + + return gfc_resolve_expr (e); + } + + /* 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. */ ! gfc_try gfc_resolve_expr (gfc_expr *e) { ! gfc_try t; if (e == NULL) return SUCCESS; *************** gfc_resolve_expr (gfc_expr *e) *** 4372,4377 **** --- 4768,4777 ---- break; + case EXPR_COMPCALL: + t = resolve_compcall (e); + break; + case EXPR_SUBSTRING: t = resolve_ref (e); break; *************** gfc_resolve_expr (gfc_expr *e) *** 4397,4404 **** /* This provides the opportunity for the length of constructors with character valued function elements to propagate the string length to the expression. */ ! if (e->ts.type == BT_CHARACTER) ! gfc_resolve_character_array_constructor (e); break; --- 4797,4804 ---- /* This provides the opportunity for the length of constructors with character valued function elements to propagate the string length to the expression. */ ! if (t == SUCCESS && e->ts.type == BT_CHARACTER) ! t = gfc_resolve_character_array_constructor (e); break; *************** gfc_resolve_expr (gfc_expr *e) *** 4428,4434 **** /* Resolve an expression from an iterator. They must be scalar and have INTEGER or (optionally) REAL type. */ ! static try gfc_resolve_iterator_expr (gfc_expr *expr, bool real_ok, const char *name_msgid) { --- 4828,4834 ---- /* Resolve an expression from an iterator. They must be scalar and have INTEGER or (optionally) REAL type. */ ! static gfc_try gfc_resolve_iterator_expr (gfc_expr *expr, bool real_ok, const char *name_msgid) { *************** gfc_resolve_iterator_expr (gfc_expr *exp *** 4469,4475 **** /* Resolve the expressions in an iterator structure. If REAL_OK is false allow only INTEGER type iterators, otherwise allow REAL types. */ ! try gfc_resolve_iterator (gfc_iterator *iter, bool real_ok) { if (gfc_resolve_iterator_expr (iter->var, real_ok, "Loop variable") --- 4869,4875 ---- /* Resolve the expressions in an iterator structure. If REAL_OK is false allow only INTEGER type iterators, otherwise allow REAL types. */ ! gfc_try gfc_resolve_iterator (gfc_iterator *iter, bool real_ok) { if (gfc_resolve_iterator_expr (iter->var, real_ok, "Loop variable") *************** forall_index (gfc_expr *expr, gfc_symbol *** 4552,4558 **** /* Check whether the FORALL index appears in the expression or not. Returns SUCCESS if SYM is found in EXPR. */ ! try find_forall_index (gfc_expr *expr, gfc_symbol *sym, int f) { if (gfc_traverse_expr (expr, sym, forall_index, f)) --- 4952,4958 ---- /* Check whether the FORALL index appears in the expression or not. Returns SUCCESS if SYM is found in EXPR. */ ! gfc_try find_forall_index (gfc_expr *expr, gfc_symbol *sym, int f) { if (gfc_traverse_expr (expr, sym, forall_index, f)) *************** derived_inaccessible (gfc_symbol *sym) *** 4652,4658 **** /* Resolve the argument of a deallocate expression. The expression must be a pointer or a full array. */ ! static try resolve_deallocate_expr (gfc_expr *e) { symbol_attribute attr; --- 5052,5058 ---- /* Resolve the argument of a deallocate expression. The expression must be a pointer or a full array. */ ! static gfc_try resolve_deallocate_expr (gfc_expr *e) { symbol_attribute attr; *************** resolve_deallocate_expr (gfc_expr *e) *** 4685,4691 **** case REF_COMPONENT: allocatable = (ref->u.c.component->as != NULL && ref->u.c.component->as->type == AS_DEFERRED); ! pointer = ref->u.c.component->pointer; break; case REF_SUBSTRING: --- 5085,5091 ---- case REF_COMPONENT: allocatable = (ref->u.c.component->as != NULL && ref->u.c.component->as->type == AS_DEFERRED); ! pointer = ref->u.c.component->attr.pointer; break; case REF_SUBSTRING: *************** sym_in_expr (gfc_expr *e, gfc_symbol *sy *** 4725,4732 **** return false; } ! static bool ! find_sym_in_expr (gfc_symbol *sym, gfc_expr *e) { return gfc_traverse_expr (e, sym, sym_in_expr, 0); } --- 5125,5132 ---- return false; } ! bool ! gfc_find_sym_in_expr (gfc_symbol *sym, gfc_expr *e) { return gfc_traverse_expr (e, sym, sym_in_expr, 0); } *************** expr_to_initialize (gfc_expr *e) *** 4767,4773 **** checks to see whether the expression is OK or not. The expression must have a trailing array reference that gives the size of the array. */ ! static try resolve_allocate_expr (gfc_expr *e, gfc_code *code) { int i, pointer, allocatable, dimension, check_intent_in; --- 5167,5173 ---- checks to see whether the expression is OK or not. The expression must have a trailing array reference that gives the size of the array. */ ! static gfc_try resolve_allocate_expr (gfc_expr *e, gfc_code *code) { int i, pointer, allocatable, dimension, check_intent_in; *************** resolve_allocate_expr (gfc_expr *e, gfc_ *** 4832,4839 **** allocatable = (ref->u.c.component->as != NULL && ref->u.c.component->as->type == AS_DEFERRED); ! pointer = ref->u.c.component->pointer; ! dimension = ref->u.c.component->dimension; break; case REF_SUBSTRING: --- 5232,5239 ---- allocatable = (ref->u.c.component->as != NULL && ref->u.c.component->as->type == AS_DEFERRED); ! pointer = ref->u.c.component->attr.pointer; ! dimension = ref->u.c.component->attr.dimension; break; case REF_SUBSTRING: *************** resolve_allocate_expr (gfc_expr *e, gfc_ *** 4841,4847 **** pointer = 0; break; } ! } } if (allocatable == 0 && pointer == 0) --- 5241,5247 ---- pointer = 0; break; } ! } } if (allocatable == 0 && pointer == 0) *************** check_symbols: *** 4923,4932 **** if (sym->ts.type == BT_DERIVED) continue; ! if ((ar->start[i] != NULL && find_sym_in_expr (sym, ar->start[i])) ! || (ar->end[i] != NULL && find_sym_in_expr (sym, ar->end[i]))) { ! gfc_error ("'%s' must not appear an the array specification at " "%L in the same ALLOCATE statement where it is " "itself allocated", sym->name, &ar->where); return FAILURE; --- 5323,5334 ---- if (sym->ts.type == BT_DERIVED) continue; ! if ((ar->start[i] != NULL ! && gfc_find_sym_in_expr (sym, ar->start[i])) ! || (ar->end[i] != NULL ! && gfc_find_sym_in_expr (sym, ar->end[i]))) { ! gfc_error ("'%s' must not appear in the array specification at " "%L in the same ALLOCATE statement where it is " "itself allocated", sym->name, &ar->where); return FAILURE; *************** resolve_allocate_deallocate (gfc_code *c *** 4942,4948 **** { gfc_symbol *s = NULL; gfc_alloc *a; - bool is_variable; if (code->expr) s = code->expr->symtree->n.sym; --- 5344,5349 ---- *************** resolve_allocate_deallocate (gfc_code *c *** 4956,5000 **** if (gfc_pure (NULL) && gfc_impure_variable (s)) gfc_error ("Illegal STAT variable in %s statement at %C " "for a PURE procedure", fcn); - - is_variable = false; - if (s->attr.flavor == FL_VARIABLE) - is_variable = true; - else if (s->attr.function && s->result == s - && (gfc_current_ns->proc_name == s - || - (gfc_current_ns->parent - && gfc_current_ns->parent->proc_name == s))) - is_variable = true; - else if (gfc_current_ns->entries && s->result == s) - { - gfc_entry_list *el; - for (el = gfc_current_ns->entries; el; el = el->next) - if (el->sym == s) - { - is_variable = true; - } - } - else if (gfc_current_ns->parent && gfc_current_ns->parent->entries - && s->result == s) - { - gfc_entry_list *el; - for (el = gfc_current_ns->parent->entries; el; el = el->next) - if (el->sym == s) - { - is_variable = true; - } - } - - if (s->attr.flavor == FL_UNKNOWN - && gfc_add_flavor (&s->attr, FL_VARIABLE, - s->name, NULL) == SUCCESS) - is_variable = true; - - if (!is_variable) - gfc_error ("STAT tag in %s statement at %L must be " - "a variable", fcn, &code->expr->where); - } if (s && code->expr->ts.type != BT_INTEGER) --- 5357,5362 ---- *************** check_case_overlap (gfc_case *list) *** 5205,5211 **** Makes sure that all case expressions are scalar constants of the same type. Return FAILURE if anything is wrong. */ ! static try validate_case_label_expr (gfc_expr *e, gfc_expr *case_expr) { if (e == NULL) return SUCCESS; --- 5567,5573 ---- Makes sure that all case expressions are scalar constants of the same type. Return FAILURE if anything is wrong. */ ! static gfc_try validate_case_label_expr (gfc_expr *e, gfc_expr *case_expr) { if (e == NULL) return SUCCESS; *************** validate_case_label_expr (gfc_expr *e, g *** 5223,5230 **** if (case_expr->ts.type == BT_CHARACTER && e->ts.kind != case_expr->ts.kind) { ! gfc_error("Expression in CASE statement at %L must be kind %d", ! &e->where, case_expr->ts.kind); return FAILURE; } --- 5585,5592 ---- if (case_expr->ts.type == BT_CHARACTER && e->ts.kind != case_expr->ts.kind) { ! gfc_error ("Expression in CASE statement at %L must be of kind %d", ! &e->where, case_expr->ts.kind); return FAILURE; } *************** resolve_select (gfc_code *code) *** 5274,5280 **** int seen_logical; int ncases; bt type; ! try t; if (code->expr == NULL) { --- 5636,5642 ---- int seen_logical; int ncases; bt type; ! gfc_try t; if (code->expr == NULL) { *************** resolve_branch (gfc_st_label *label, gfc *** 5662,5668 **** if (code->here == label) { ! gfc_warning ("Branch at %L causes an infinite loop", &code->loc); return; } --- 6024,6030 ---- if (code->here == label) { ! gfc_warning ("Branch at %L may result in an infinite loop", &code->loc); return; } *************** resolve_branch (gfc_st_label *label, gfc *** 5715,5726 **** /* Check whether EXPR1 has the same shape as EXPR2. */ ! static try resolve_where_shape (gfc_expr *expr1, gfc_expr *expr2) { mpz_t shape[GFC_MAX_DIMENSIONS]; mpz_t shape2[GFC_MAX_DIMENSIONS]; ! try result = FAILURE; int i; /* Compare the rank. */ --- 6077,6088 ---- /* Check whether EXPR1 has the same shape as EXPR2. */ ! static gfc_try resolve_where_shape (gfc_expr *expr1, gfc_expr *expr2) { mpz_t shape[GFC_MAX_DIMENSIONS]; mpz_t shape2[GFC_MAX_DIMENSIONS]; ! gfc_try result = FAILURE; int i; /* Compare the rank. */ *************** gfc_resolve_assign_in_forall (gfc_code * *** 5851,5861 **** else { /* If one of the FORALL index variables doesn't appear in the ! assignment target, then there will be a many-to-one ! assignment. */ if (find_forall_index (code->expr, forall_index, 0) == FAILURE) ! gfc_warning ("The FORALL with index '%s' might cause more than " ! "one assignment to this object at %L", var_expr[n]->symtree->name, &code->expr->where); } } --- 6213,6225 ---- else { /* If one of the FORALL index variables doesn't appear in the ! assignment variable, then there could be a many-to-one ! assignment. Emit a warning rather than an error because the ! mask could be resolving this problem. */ if (find_forall_index (code->expr, forall_index, 0) == FAILURE) ! gfc_warning ("The FORALL with index '%s' is not used on the " ! "left side of the assignment at %L and so might " ! "cause multiple assignment to this object", var_expr[n]->symtree->name, &code->expr->where); } } *************** static void resolve_code (gfc_code *, gf *** 6068,6074 **** void gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) { ! try t; for (; b; b = b->block) { --- 6432,6438 ---- void gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) { ! gfc_try t; for (; b; b = b->block) { *************** gfc_resolve_blocks (gfc_code *b, gfc_nam *** 6104,6109 **** --- 6468,6474 ---- case EXEC_READ: case EXEC_WRITE: case EXEC_IOLENGTH: + case EXEC_WAIT: break; case EXEC_OMP_ATOMIC: *************** gfc_resolve_blocks (gfc_code *b, gfc_nam *** 6117,6122 **** --- 6482,6489 ---- case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: + case EXEC_OMP_TASK: + case EXEC_OMP_TASKWAIT: case EXEC_OMP_WORKSHARE: break; *************** gfc_resolve_blocks (gfc_code *b, gfc_nam *** 6130,6136 **** /* Does everything to resolve an ordinary assignment. Returns true ! if this is an interface asignment. */ static bool resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) { --- 6497,6503 ---- /* Does everything to resolve an ordinary assignment. Returns true ! if this is an interface assignment. */ static bool resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) { *************** resolve_ordinary_assign (gfc_code *code, *** 6235,6242 **** { for (n = 0; n < ref->u.ar.dimen; n++) if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR ! && find_sym_in_expr (lhs->symtree->n.sym, ! ref->u.ar.start[n])) ref->u.ar.start[n] = gfc_get_parentheses (ref->u.ar.start[n]); } --- 6602,6609 ---- { for (n = 0; n < ref->u.ar.dimen; n++) if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR ! && gfc_find_sym_in_expr (lhs->symtree->n.sym, ! ref->u.ar.start[n])) ref->u.ar.start[n] = gfc_get_parentheses (ref->u.ar.start[n]); } *************** resolve_code (gfc_code *code, gfc_namesp *** 6279,6285 **** int omp_workshare_save; int forall_save; code_stack frame; ! try t; frame.prev = cs_base; frame.head = code; --- 6646,6652 ---- int omp_workshare_save; int forall_save; code_stack frame; ! gfc_try t; frame.prev = cs_base; frame.head = code; *************** resolve_code (gfc_code *code, gfc_namesp *** 6311,6316 **** --- 6678,6684 ---- case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_TASK: omp_workshare_save = omp_workshare_flag; omp_workshare_flag = 0; gfc_resolve_omp_parallel_blocks (code, ns); *************** resolve_code (gfc_code *code, gfc_namesp *** 6331,6337 **** omp_workshare_flag = omp_workshare_save; } ! t = gfc_resolve_expr (code->expr); forall_flag = forall_save; if (gfc_resolve_expr (code->expr2) == FAILURE) --- 6699,6707 ---- omp_workshare_flag = omp_workshare_save; } ! t = SUCCESS; ! if (code->op != EXEC_COMPCALL) ! t = gfc_resolve_expr (code->expr); forall_flag = forall_save; if (gfc_resolve_expr (code->expr2) == FAILURE) *************** resolve_code (gfc_code *code, gfc_namesp *** 6437,6442 **** --- 6807,6816 ---- resolve_call (code); break; + case EXEC_COMPCALL: + resolve_typebound_call (code); + break; + case EXEC_SELECT: /* Select is complicated. Also, a SELECT construct could be a transformed computed GOTO. */ *************** resolve_code (gfc_code *code, gfc_namesp *** 6513,6518 **** --- 6887,6901 ---- resolve_branch (code->ext.inquire->err, code); break; + case EXEC_WAIT: + if (gfc_resolve_wait (code->ext.wait) == FAILURE) + break; + + resolve_branch (code->ext.wait->err, code); + resolve_branch (code->ext.wait->end, code); + resolve_branch (code->ext.wait->eor, code); + break; + case EXEC_READ: case EXEC_WRITE: if (gfc_resolve_dt (code->ext.dt) == FAILURE) *************** resolve_code (gfc_code *code, gfc_namesp *** 6544,6549 **** --- 6927,6933 ---- case EXEC_OMP_ORDERED: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: + case EXEC_OMP_TASKWAIT: case EXEC_OMP_WORKSHARE: gfc_resolve_omp_directive (code, ns); break; *************** resolve_code (gfc_code *code, gfc_namesp *** 6552,6557 **** --- 6936,6942 ---- case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_TASK: omp_workshare_save = omp_workshare_flag; omp_workshare_flag = 0; gfc_resolve_omp_directive (code, ns); *************** gfc_verify_binding_labels (gfc_symbol *s *** 6742,6751 **** has_error = 1; } else if (sym->attr.contained == 0 ! && (sym->attr.if_source == IFSRC_UNKNOWN)) ! if ((sym->attr.use_assoc ! && (strcmp (bind_c_sym->mod_name, sym->module) != 0)) ! || sym->attr.use_assoc == 0) { gfc_error ("Binding label '%s' at %L collides with global " "entity '%s' at %L", sym->binding_label, --- 7127,7136 ---- has_error = 1; } else if (sym->attr.contained == 0 ! && sym->attr.if_source == IFSRC_UNKNOWN) ! if ((sym->attr.use_assoc && bind_c_sym->mod_name ! && strcmp (bind_c_sym->mod_name, sym->module) != 0) ! || sym->attr.use_assoc == 0) { gfc_error ("Binding label '%s' at %L collides with global " "entity '%s' at %L", sym->binding_label, *************** gfc_verify_binding_labels (gfc_symbol *s *** 6785,6791 **** /* Resolve an index expression. */ ! static try resolve_index_expr (gfc_expr *e) { if (gfc_resolve_expr (e) == FAILURE) --- 7170,7176 ---- /* Resolve an index expression. */ ! static gfc_try resolve_index_expr (gfc_expr *e) { if (gfc_resolve_expr (e) == FAILURE) *************** resolve_index_expr (gfc_expr *e) *** 6802,6808 **** /* Resolve a charlen structure. */ ! static try resolve_charlen (gfc_charlen *cl) { int i; --- 7187,7193 ---- /* Resolve a charlen structure. */ ! static gfc_try resolve_charlen (gfc_charlen *cl) { int i; *************** build_default_init_expr (gfc_symbol *sym *** 6934,6940 **** int char_len; gfc_expr *init_expr; int i; - char *ch; /* These symbols should never have a default initialization. */ if ((sym->attr.dimension && !gfc_is_compile_time_shape (sym->as)) --- 7319,7324 ---- *************** build_default_init_expr (gfc_symbol *sym *** 7052,7061 **** { char_len = mpz_get_si (sym->ts.cl->length->value.integer); init_expr->value.character.length = char_len; ! init_expr->value.character.string = gfc_getmem (char_len+1); ! ch = init_expr->value.character.string; for (i = 0; i < char_len; i++) ! *(ch++) = gfc_option.flag_init_character_value; } else { --- 7436,7445 ---- { char_len = mpz_get_si (sym->ts.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 { *************** apply_default_init_local (gfc_symbol *sy *** 7103,7109 **** /* Resolution of common features of flavors variable and procedure. */ ! static try resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag) { /* Constraints on deferred shape variable. */ --- 7487,7493 ---- /* Resolution of common features of flavors variable and procedure. */ ! static gfc_try resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag) { /* Constraints on deferred shape variable. */ *************** resolve_fl_var_and_proc (gfc_symbol *sym *** 7145,7151 **** /* Additional checks for symbols with flavor variable and derived type. To be called from resolve_fl_variable. */ ! static try resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag) { gcc_assert (sym->ts.type == BT_DERIVED); --- 7529,7535 ---- /* Additional checks for symbols with flavor variable and derived type. To be called from resolve_fl_variable. */ ! static gfc_try resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag) { gcc_assert (sym->ts.type == BT_DERIVED); *************** resolve_fl_variable_derived (gfc_symbol *** 7203,7209 **** /* Resolve symbols with flavor variable. */ ! static try resolve_fl_variable (gfc_symbol *sym, int mp_flag) { int no_init_flag, automatic_flag; --- 7587,7593 ---- /* Resolve symbols with flavor variable. */ ! static gfc_try resolve_fl_variable (gfc_symbol *sym, int mp_flag) { int no_init_flag, automatic_flag; *************** no_init_error: *** 7332,7338 **** /* Resolve a procedure. */ ! static try resolve_fl_procedure (gfc_symbol *sym, int mp_flag) { gfc_formal_arglist *arg; --- 7716,7722 ---- /* Resolve a procedure. */ ! static gfc_try resolve_fl_procedure (gfc_symbol *sym, int mp_flag) { gfc_formal_arglist *arg; *************** resolve_fl_procedure (gfc_symbol *sym, i *** 7374,7380 **** } /* Ensure that derived type for are not of a private type. Internal ! module procedures are excluded by 2.2.3.3 - ie. they are not externally accessible and can access all the objects accessible in the host. */ if (!(sym->ns->parent --- 7758,7764 ---- } /* Ensure that derived type for are not of a private type. Internal ! module procedures are excluded by 2.2.3.3 - i.e., they are not externally accessible and can access all the objects accessible in the host. */ if (!(sym->ns->parent *************** resolve_fl_procedure (gfc_symbol *sym, i *** 7453,7459 **** } } ! if (sym->attr.function && sym->value && sym->attr.proc != PROC_ST_FUNCTION) { gfc_error ("Function '%s' at %L cannot have an initializer", sym->name, &sym->declared_at); --- 7837,7844 ---- } } ! if (sym->attr.function && sym->value && sym->attr.proc != PROC_ST_FUNCTION ! && !sym->attr.proc_pointer) { gfc_error ("Function '%s' at %L cannot have an initializer", sym->name, &sym->declared_at); *************** resolve_fl_procedure (gfc_symbol *sym, i *** 7461,7468 **** } /* An external symbol may not have an initializer because it is taken to be ! a procedure. */ ! if (sym->attr.external && sym->value) { gfc_error ("External object '%s' at %L may not have an initializer", sym->name, &sym->declared_at); --- 7846,7853 ---- } /* An external symbol may not have an initializer because it is taken to be ! a procedure. Exception: Procedure Pointers. */ ! if (sym->attr.external && sym->value && !sym->attr.proc_pointer) { gfc_error ("External object '%s' at %L may not have an initializer", sym->name, &sym->declared_at); *************** resolve_fl_procedure (gfc_symbol *sym, i *** 7565,7574 **** --- 7950,8641 ---- } } + if (sym->attr.save == SAVE_EXPLICIT && !sym->attr.proc_pointer) + { + gfc_error ("PROCEDURE attribute conflicts with SAVE attribute " + "in '%s' at %L", sym->name, &sym->declared_at); + return FAILURE; + } + + if (sym->attr.intent && !sym->attr.proc_pointer) + { + gfc_error ("PROCEDURE attribute conflicts with INTENT attribute " + "in '%s' at %L", sym->name, &sym->declared_at); + return FAILURE; + } + + return SUCCESS; + } + + + /* Resolve a list of finalizer procedures. That is, after they have hopefully + been defined and we now know their defined arguments, check that they fulfill + the requirements of the standard for procedures used as finalizers. */ + + static gfc_try + gfc_resolve_finalizers (gfc_symbol* derived) + { + gfc_finalizer* list; + gfc_finalizer** prev_link; /* For removing wrong entries from the list. */ + gfc_try result = SUCCESS; + bool seen_scalar = false; + + if (!derived->f2k_derived || !derived->f2k_derived->finalizers) + return SUCCESS; + + /* Walk over the list of finalizer-procedures, check them, and if any one + does not fit in with the standard's definition, print an error and remove + it from the list. */ + prev_link = &derived->f2k_derived->finalizers; + for (list = derived->f2k_derived->finalizers; list; list = *prev_link) + { + gfc_symbol* arg; + gfc_finalizer* i; + int my_rank; + + /* Skip this finalizer if we already resolved it. */ + if (list->proc_tree) + { + prev_link = &(list->next); + continue; + } + + /* Check this exists and is a SUBROUTINE. */ + if (!list->proc_sym->attr.subroutine) + { + gfc_error ("FINAL procedure '%s' at %L is not a SUBROUTINE", + list->proc_sym->name, &list->where); + goto error; + } + + /* We should have exactly one argument. */ + if (!list->proc_sym->formal || list->proc_sym->formal->next) + { + gfc_error ("FINAL procedure at %L must have exactly one argument", + &list->where); + goto error; + } + arg = list->proc_sym->formal->sym; + + /* This argument must be of our type. */ + if (arg->ts.type != BT_DERIVED || arg->ts.derived != derived) + { + gfc_error ("Argument of FINAL procedure at %L must be of type '%s'", + &arg->declared_at, derived->name); + goto error; + } + + /* It must neither be a pointer nor allocatable nor optional. */ + if (arg->attr.pointer) + { + gfc_error ("Argument of FINAL procedure at %L must not be a POINTER", + &arg->declared_at); + goto error; + } + if (arg->attr.allocatable) + { + gfc_error ("Argument of FINAL procedure at %L must not be" + " ALLOCATABLE", &arg->declared_at); + goto error; + } + if (arg->attr.optional) + { + gfc_error ("Argument of FINAL procedure at %L must not be OPTIONAL", + &arg->declared_at); + goto error; + } + + /* It must not be INTENT(OUT). */ + if (arg->attr.intent == INTENT_OUT) + { + gfc_error ("Argument of FINAL procedure at %L must not be" + " INTENT(OUT)", &arg->declared_at); + goto error; + } + + /* Warn if the procedure is non-scalar and not assumed shape. */ + if (gfc_option.warn_surprising && arg->as && arg->as->rank > 0 + && arg->as->type != AS_ASSUMED_SHAPE) + gfc_warning ("Non-scalar FINAL procedure at %L should have assumed" + " shape argument", &arg->declared_at); + + /* Check that it does not match in kind and rank with a FINAL procedure + defined earlier. To really loop over the *earlier* declarations, + we need to walk the tail of the list as new ones were pushed at the + front. */ + /* TODO: Handle kind parameters once they are implemented. */ + my_rank = (arg->as ? arg->as->rank : 0); + for (i = list->next; i; i = i->next) + { + /* Argument list might be empty; that is an error signalled earlier, + but we nevertheless continued resolving. */ + if (i->proc_sym->formal) + { + gfc_symbol* i_arg = i->proc_sym->formal->sym; + const int i_rank = (i_arg->as ? i_arg->as->rank : 0); + if (i_rank == my_rank) + { + gfc_error ("FINAL procedure '%s' declared at %L has the same" + " rank (%d) as '%s'", + list->proc_sym->name, &list->where, my_rank, + i->proc_sym->name); + goto error; + } + } + } + + /* Is this the/a scalar finalizer procedure? */ + if (!arg->as || arg->as->rank == 0) + seen_scalar = true; + + /* Find the symtree for this procedure. */ + gcc_assert (!list->proc_tree); + list->proc_tree = gfc_find_sym_in_symtree (list->proc_sym); + + prev_link = &list->next; + continue; + + /* Remove wrong nodes immediately from the list so we don't risk any + troubles in the future when they might fail later expectations. */ + error: + result = FAILURE; + i = list; + *prev_link = list->next; + gfc_free_finalizer (i); + } + + /* 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 (gfc_option.warn_surprising && result == SUCCESS && !seen_scalar) + gfc_warning ("Only array FINAL procedures declared for derived type '%s'" + " defined at %L, suggest also scalar one", + derived->name, &derived->declared_at); + + /* TODO: Remove this error when finalization is finished. */ + gfc_error ("Finalization at %L is not yet implemented", + &derived->declared_at); + + return result; + } + + + /* Check that it is ok for the typebound procedure proc to override the + procedure old. */ + + static gfc_try + check_typebound_override (gfc_symtree* proc, gfc_symtree* old) + { + locus where; + const gfc_symbol* proc_target; + const gfc_symbol* old_target; + unsigned proc_pass_arg, old_pass_arg, argpos; + gfc_formal_arglist* proc_formal; + gfc_formal_arglist* old_formal; + + /* This procedure should only be called for non-GENERIC proc. */ + gcc_assert (!proc->typebound->is_generic); + + /* If the overwritten procedure is GENERIC, this is an error. */ + if (old->typebound->is_generic) + { + gfc_error ("Can't overwrite GENERIC '%s' at %L", + old->name, &proc->typebound->where); + return FAILURE; + } + + where = proc->typebound->where; + proc_target = proc->typebound->u.specific->n.sym; + old_target = old->typebound->u.specific->n.sym; + + /* Check that overridden binding is not NON_OVERRIDABLE. */ + if (old->typebound->non_overridable) + { + gfc_error ("'%s' at %L overrides a procedure binding declared" + " NON_OVERRIDABLE", proc->name, &where); + return FAILURE; + } + + /* If the overridden binding is PURE, the overriding must be, too. */ + if (old_target->attr.pure && !proc_target->attr.pure) + { + gfc_error ("'%s' at %L overrides a PURE procedure and must also be PURE", + proc->name, &where); + return FAILURE; + } + + /* If the overridden binding is ELEMENTAL, the overriding must be, too. If it + is not, the overriding must not be either. */ + if (old_target->attr.elemental && !proc_target->attr.elemental) + { + gfc_error ("'%s' at %L overrides an ELEMENTAL procedure and must also be" + " ELEMENTAL", proc->name, &where); + return FAILURE; + } + if (!old_target->attr.elemental && proc_target->attr.elemental) + { + gfc_error ("'%s' at %L overrides a non-ELEMENTAL procedure and must not" + " be ELEMENTAL, either", proc->name, &where); + return FAILURE; + } + + /* If the overridden binding is a SUBROUTINE, the overriding must also be a + SUBROUTINE. */ + if (old_target->attr.subroutine && !proc_target->attr.subroutine) + { + gfc_error ("'%s' at %L overrides a SUBROUTINE and must also be a" + " SUBROUTINE", proc->name, &where); + return FAILURE; + } + + /* If the overridden binding is a FUNCTION, the overriding must also be a + FUNCTION and have the same characteristics. */ + if (old_target->attr.function) + { + if (!proc_target->attr.function) + { + gfc_error ("'%s' at %L overrides a FUNCTION and must also be a" + " FUNCTION", proc->name, &where); + return FAILURE; + } + + /* FIXME: Do more comprehensive checking (including, for instance, the + rank and array-shape). */ + gcc_assert (proc_target->result && old_target->result); + if (!gfc_compare_types (&proc_target->result->ts, + &old_target->result->ts)) + { + gfc_error ("'%s' at %L and the overridden FUNCTION should have" + " matching result types", proc->name, &where); + return FAILURE; + } + } + + /* If the overridden binding is PUBLIC, the overriding one must not be + PRIVATE. */ + if (old->typebound->access == ACCESS_PUBLIC + && proc->typebound->access == ACCESS_PRIVATE) + { + gfc_error ("'%s' at %L overrides a PUBLIC procedure and must not be" + " PRIVATE", proc->name, &where); + return FAILURE; + } + + /* Compare the formal argument lists of both procedures. This is also abused + to find the position of the passed-object dummy arguments of both + bindings as at least the overridden one might not yet be resolved and we + need those positions in the check below. */ + proc_pass_arg = old_pass_arg = 0; + if (!proc->typebound->nopass && !proc->typebound->pass_arg) + proc_pass_arg = 1; + if (!old->typebound->nopass && !old->typebound->pass_arg) + old_pass_arg = 1; + argpos = 1; + for (proc_formal = proc_target->formal, old_formal = old_target->formal; + proc_formal && old_formal; + proc_formal = proc_formal->next, old_formal = old_formal->next) + { + if (proc->typebound->pass_arg + && !strcmp (proc->typebound->pass_arg, proc_formal->sym->name)) + proc_pass_arg = argpos; + if (old->typebound->pass_arg + && !strcmp (old->typebound->pass_arg, old_formal->sym->name)) + old_pass_arg = argpos; + + /* Check that the names correspond. */ + if (strcmp (proc_formal->sym->name, old_formal->sym->name)) + { + gfc_error ("Dummy argument '%s' of '%s' at %L should be named '%s' as" + " to match the corresponding argument of the overridden" + " procedure", proc_formal->sym->name, proc->name, &where, + old_formal->sym->name); + return FAILURE; + } + + /* Check that the types correspond if neither is the passed-object + argument. */ + /* FIXME: Do more comprehensive testing here. */ + if (proc_pass_arg != argpos && old_pass_arg != argpos + && !gfc_compare_types (&proc_formal->sym->ts, &old_formal->sym->ts)) + { + gfc_error ("Types mismatch for dummy argument '%s' of '%s' %L in" + " in respect to the overridden procedure", + proc_formal->sym->name, proc->name, &where); + return FAILURE; + } + + ++argpos; + } + if (proc_formal || old_formal) + { + gfc_error ("'%s' at %L must have the same number of formal arguments as" + " the overridden procedure", proc->name, &where); + return FAILURE; + } + + /* If the overridden binding is NOPASS, the overriding one must also be + NOPASS. */ + if (old->typebound->nopass && !proc->typebound->nopass) + { + gfc_error ("'%s' at %L overrides a NOPASS binding and must also be" + " NOPASS", proc->name, &where); + return FAILURE; + } + + /* If the overridden binding is PASS(x), the overriding one must also be + PASS and the passed-object dummy arguments must correspond. */ + if (!old->typebound->nopass) + { + if (proc->typebound->nopass) + { + gfc_error ("'%s' at %L overrides a binding with PASS and must also be" + " PASS", proc->name, &where); + return FAILURE; + } + + if (proc_pass_arg != old_pass_arg) + { + gfc_error ("Passed-object dummy argument of '%s' at %L must be at" + " the same position as the passed-object dummy argument of" + " the overridden procedure", proc->name, &where); + return FAILURE; + } + } + + return SUCCESS; + } + + + /* Check if two GENERIC targets are ambiguous and emit an error is they are. */ + + static gfc_try + check_generic_tbp_ambiguity (gfc_tbp_generic* t1, gfc_tbp_generic* t2, + const char* generic_name, locus where) + { + gfc_symbol* sym1; + gfc_symbol* sym2; + + gcc_assert (t1->specific && t2->specific); + gcc_assert (!t1->specific->is_generic); + gcc_assert (!t2->specific->is_generic); + + sym1 = t1->specific->u.specific->n.sym; + sym2 = t2->specific->u.specific->n.sym; + + /* Both must be SUBROUTINEs or both must be FUNCTIONs. */ + if (sym1->attr.subroutine != sym2->attr.subroutine + || sym1->attr.function != sym2->attr.function) + { + gfc_error ("'%s' and '%s' can't be mixed FUNCTION/SUBROUTINE for" + " GENERIC '%s' at %L", + sym1->name, sym2->name, generic_name, &where); + return FAILURE; + } + + /* Compare the interfaces. */ + if (gfc_compare_interfaces (sym1, sym2, 1)) + { + gfc_error ("'%s' and '%s' for GENERIC '%s' at %L are ambiguous", + sym1->name, sym2->name, generic_name, &where); + return FAILURE; + } + + return SUCCESS; + } + + + /* Resolve a GENERIC procedure binding for a derived type. */ + + static gfc_try + resolve_typebound_generic (gfc_symbol* derived, gfc_symtree* st) + { + gfc_tbp_generic* target; + gfc_symtree* first_target; + gfc_symbol* super_type; + gfc_symtree* inherited; + locus where; + + gcc_assert (st->typebound); + gcc_assert (st->typebound->is_generic); + + where = st->typebound->where; + super_type = gfc_get_derived_super_type (derived); + + /* Find the overridden binding if any. */ + st->typebound->overridden = NULL; + if (super_type) + { + gfc_symtree* overridden; + overridden = gfc_find_typebound_proc (super_type, NULL, st->name, true); + + if (overridden && overridden->typebound) + st->typebound->overridden = overridden->typebound; + } + + /* Try to find the specific bindings for the symtrees in our target-list. */ + gcc_assert (st->typebound->u.generic); + for (target = st->typebound->u.generic; target; target = target->next) + if (!target->specific) + { + gfc_typebound_proc* overridden_tbp; + gfc_tbp_generic* g; + const char* target_name; + + target_name = target->specific_st->name; + + /* Defined for this type directly. */ + if (target->specific_st->typebound) + { + target->specific = target->specific_st->typebound; + goto specific_found; + } + + /* Look for an inherited specific binding. */ + if (super_type) + { + inherited = gfc_find_typebound_proc (super_type, NULL, + target_name, true); + + if (inherited) + { + gcc_assert (inherited->typebound); + target->specific = inherited->typebound; + goto specific_found; + } + } + + gfc_error ("Undefined specific binding '%s' as target of GENERIC '%s'" + " at %L", target_name, st->name, &where); + return FAILURE; + + /* Once we've found the specific binding, check it is not ambiguous with + other specifics already found or inherited for the same GENERIC. */ + specific_found: + gcc_assert (target->specific); + + /* This must really be a specific binding! */ + if (target->specific->is_generic) + { + gfc_error ("GENERIC '%s' at %L must target a specific binding," + " '%s' is GENERIC, too", st->name, &where, target_name); + return FAILURE; + } + + /* Check those already resolved on this type directly. */ + for (g = st->typebound->u.generic; g; g = g->next) + if (g != target && g->specific + && check_generic_tbp_ambiguity (target, g, st->name, where) + == FAILURE) + return FAILURE; + + /* Check for ambiguity with inherited specific targets. */ + for (overridden_tbp = st->typebound->overridden; overridden_tbp; + overridden_tbp = overridden_tbp->overridden) + if (overridden_tbp->is_generic) + { + for (g = overridden_tbp->u.generic; g; g = g->next) + { + gcc_assert (g->specific); + if (check_generic_tbp_ambiguity (target, g, + st->name, where) == FAILURE) + return FAILURE; + } + } + } + + /* If we attempt to "overwrite" a specific binding, this is an error. */ + if (st->typebound->overridden && !st->typebound->overridden->is_generic) + { + gfc_error ("GENERIC '%s' at %L can't overwrite specific binding with" + " the same name", st->name, &where); + return FAILURE; + } + + /* Take the SUBROUTINE/FUNCTION attributes of the first specific target, as + all must have the same attributes here. */ + first_target = st->typebound->u.generic->specific->u.specific; + st->typebound->subroutine = first_target->n.sym->attr.subroutine; + st->typebound->function = first_target->n.sym->attr.function; + return SUCCESS; } + /* Resolve the type-bound procedures for a derived type. */ + + static gfc_symbol* resolve_bindings_derived; + static gfc_try resolve_bindings_result; + + static void + resolve_typebound_procedure (gfc_symtree* stree) + { + gfc_symbol* proc; + locus where; + gfc_symbol* me_arg; + gfc_symbol* super_type; + gfc_component* comp; + + /* If this is no type-bound procedure, just return. */ + if (!stree->typebound) + return; + + /* If this is a GENERIC binding, use that routine. */ + if (stree->typebound->is_generic) + { + if (resolve_typebound_generic (resolve_bindings_derived, stree) + == FAILURE) + goto error; + return; + } + + /* Get the target-procedure to check it. */ + gcc_assert (!stree->typebound->is_generic); + gcc_assert (stree->typebound->u.specific); + proc = stree->typebound->u.specific->n.sym; + where = stree->typebound->where; + + /* Default access should already be resolved from the parser. */ + gcc_assert (stree->typebound->access != ACCESS_UNKNOWN); + + /* It should be a module procedure or an external procedure with explicit + interface. */ + if ((!proc->attr.subroutine && !proc->attr.function) + || (proc->attr.proc != PROC_MODULE + && proc->attr.if_source != IFSRC_IFBODY) + || proc->attr.abstract) + { + gfc_error ("'%s' must be a module procedure or an external procedure with" + " an explicit interface at %L", proc->name, &where); + goto error; + } + stree->typebound->subroutine = proc->attr.subroutine; + stree->typebound->function = proc->attr.function; + + /* Find the super-type of the current derived type. We could do this once and + store in a global if speed is needed, but as long as not I believe this is + more readable and clearer. */ + super_type = gfc_get_derived_super_type (resolve_bindings_derived); + + /* If PASS, resolve and check arguments if not already resolved / loaded + from a .mod file. */ + if (!stree->typebound->nopass && stree->typebound->pass_arg_num == 0) + { + if (stree->typebound->pass_arg) + { + gfc_formal_arglist* i; + + /* If an explicit passing argument name is given, walk the arg-list + and look for it. */ + + me_arg = NULL; + stree->typebound->pass_arg_num = 1; + for (i = proc->formal; i; i = i->next) + { + if (!strcmp (i->sym->name, stree->typebound->pass_arg)) + { + me_arg = i->sym; + break; + } + ++stree->typebound->pass_arg_num; + } + + if (!me_arg) + { + gfc_error ("Procedure '%s' with PASS(%s) at %L has no" + " argument '%s'", + proc->name, stree->typebound->pass_arg, &where, + stree->typebound->pass_arg); + goto error; + } + } + else + { + /* Otherwise, take the first one; there should in fact be at least + one. */ + stree->typebound->pass_arg_num = 1; + if (!proc->formal) + { + gfc_error ("Procedure '%s' with PASS at %L must have at" + " least one argument", proc->name, &where); + goto error; + } + me_arg = proc->formal->sym; + } + + /* Now check that the argument-type matches. */ + gcc_assert (me_arg); + if (me_arg->ts.type != BT_DERIVED + || me_arg->ts.derived != resolve_bindings_derived) + { + gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L must be of" + " the derived-type '%s'", me_arg->name, proc->name, + me_arg->name, &where, resolve_bindings_derived->name); + goto error; + } + + gfc_warning ("Polymorphic entities are not yet implemented," + " non-polymorphic passed-object dummy argument of '%s'" + " at %L accepted", proc->name, &where); + } + + /* If we are extending some type, check that we don't override a procedure + flagged NON_OVERRIDABLE. */ + stree->typebound->overridden = NULL; + if (super_type) + { + gfc_symtree* overridden; + overridden = gfc_find_typebound_proc (super_type, NULL, + stree->name, true); + + if (overridden && overridden->typebound) + stree->typebound->overridden = overridden->typebound; + + if (overridden && check_typebound_override (stree, overridden) == FAILURE) + goto error; + } + + /* See if there's a name collision with a component directly in this type. */ + for (comp = resolve_bindings_derived->components; comp; comp = comp->next) + if (!strcmp (comp->name, stree->name)) + { + gfc_error ("Procedure '%s' at %L has the same name as a component of" + " '%s'", + stree->name, &where, resolve_bindings_derived->name); + goto error; + } + + /* Try to find a name collision with an inherited component. */ + if (super_type && gfc_find_component (super_type, stree->name, true, true)) + { + gfc_error ("Procedure '%s' at %L has the same name as an inherited" + " component of '%s'", + stree->name, &where, resolve_bindings_derived->name); + goto error; + } + + stree->typebound->error = 0; + return; + + error: + resolve_bindings_result = FAILURE; + stree->typebound->error = 1; + } + + static gfc_try + resolve_typebound_procedures (gfc_symbol* derived) + { + if (!derived->f2k_derived || !derived->f2k_derived->sym_root) + return SUCCESS; + + resolve_bindings_derived = derived; + resolve_bindings_result = SUCCESS; + gfc_traverse_symtree (derived->f2k_derived->sym_root, + &resolve_typebound_procedure); + + return resolve_bindings_result; + } + + /* Add a derived type to the dt_list. The dt_list is used in trans-types.c to give all identical derived types the same backend_decl. */ static void *************** add_dt_to_dt_list (gfc_symbol *derived) *** 7592,7605 **** /* Resolve the components of a derived type. */ ! static try resolve_fl_derived (gfc_symbol *sym) { gfc_component *c; int i; for (c = sym->components; c != NULL; c = c->next) { if (c->ts.type == BT_CHARACTER) { if (c->ts.cl->length == NULL --- 8659,8703 ---- /* Resolve the components of a derived type. */ ! static gfc_try resolve_fl_derived (gfc_symbol *sym) { + gfc_symbol* super_type; gfc_component *c; int i; + super_type = gfc_get_derived_super_type (sym); + + /* Ensure the extended type gets resolved before we do. */ + if (super_type && resolve_fl_derived (super_type) == FAILURE) + return FAILURE; + + /* An ABSTRACT type must be extensible. */ + if (sym->attr.abstract && (sym->attr.is_bind_c || sym->attr.sequence)) + { + gfc_error ("Non-extensible derived-type '%s' at %L must not be ABSTRACT", + sym->name, &sym->declared_at); + return FAILURE; + } + for (c = sym->components; c != NULL; c = c->next) { + /* Check type-spec if this is not the parent-type component. */ + if ((!sym->attr.extension || c != sym->components) + && resolve_typespec_used (&c->ts, &c->loc, c->name) == FAILURE) + return FAILURE; + + /* If this type is an extension, see if this component has the same name + as an inherited type-bound procedure. */ + if (super_type + && gfc_find_typebound_proc (super_type, NULL, c->name, true)) + { + gfc_error ("Component '%s' of '%s' at %L has the same name as an" + " inherited type-bound procedure", + c->name, sym->name, &c->loc); + return FAILURE; + } + if (c->ts.type == BT_CHARACTER) { if (c->ts.cl->length == NULL *************** resolve_fl_derived (gfc_symbol *sym) *** 7638,7645 **** } } ! if (c->ts.type == BT_DERIVED && c->pointer ! && c->ts.derived->components == NULL) { gfc_error ("The pointer component '%s' of '%s' at %L is a type " "that has not been declared", c->name, sym->name, --- 8736,8744 ---- } } ! if (c->ts.type == BT_DERIVED && c->attr.pointer ! && c->ts.derived->components == NULL ! && !c->ts.derived->attr.zero_comp) { gfc_error ("The pointer component '%s' of '%s' at %L is a type " "that has not been declared", c->name, sym->name, *************** resolve_fl_derived (gfc_symbol *sym) *** 7653,7663 **** if (c->ts.type == BT_DERIVED && c->ts.derived && c->ts.derived->components ! && c->pointer && sym != c->ts.derived) add_dt_to_dt_list (c->ts.derived); ! if (c->pointer || c->allocatable || c->as == NULL) continue; for (i = 0; i < c->as->rank; i++) --- 8752,8762 ---- if (c->ts.type == BT_DERIVED && c->ts.derived && c->ts.derived->components ! && c->attr.pointer && sym != c->ts.derived) add_dt_to_dt_list (c->ts.derived); ! if (c->attr.pointer || c->attr.allocatable || c->as == NULL) continue; for (i = 0; i < c->as->rank; i++) *************** resolve_fl_derived (gfc_symbol *sym) *** 7677,7682 **** --- 8776,8789 ---- } } + /* Resolve the type-bound procedures. */ + if (resolve_typebound_procedures (sym) == FAILURE) + return FAILURE; + + /* Resolve the finalizer procedures. */ + if (gfc_resolve_finalizers (sym) == FAILURE) + return FAILURE; + /* Add derived type to the derived type list. */ add_dt_to_dt_list (sym); *************** resolve_fl_derived (gfc_symbol *sym) *** 7684,7690 **** } ! static try resolve_fl_namelist (gfc_symbol *sym) { gfc_namelist *nl; --- 8791,8797 ---- } ! static gfc_try resolve_fl_namelist (gfc_symbol *sym) { gfc_namelist *nl; *************** resolve_fl_namelist (gfc_symbol *sym) *** 7803,7809 **** } ! static try resolve_fl_parameter (gfc_symbol *sym) { /* A parameter array's shape needs to be constant. */ --- 8910,8916 ---- } ! static gfc_try resolve_fl_parameter (gfc_symbol *sym) { /* A parameter array's shape needs to be constant. */ *************** resolve_symbol (gfc_symbol *sym) *** 7888,7913 **** } } ! if (sym->attr.procedure && sym->interface && sym->attr.if_source != IFSRC_DECL) { ! if (sym->interface->attr.procedure) gfc_error ("Interface '%s', used by procedure '%s' at %L, is declared " ! "in a later PROCEDURE statement", sym->interface->name, sym->name,&sym->declared_at); /* Get the attributes from the interface (now resolved). */ ! if (sym->interface->attr.if_source || sym->interface->attr.intrinsic) { ! sym->ts = sym->interface->ts; ! sym->attr.function = sym->interface->attr.function; ! sym->attr.subroutine = sym->interface->attr.subroutine; ! copy_formal_args (sym, sym->interface); } ! else if (sym->interface->name[0] != '\0') { gfc_error ("Interface '%s' of procedure '%s' at %L must be explicit", ! sym->interface->name, sym->name, &sym->declared_at); return; } } --- 8995,9054 ---- } } ! if (sym->attr.procedure && sym->ts.interface && sym->attr.if_source != IFSRC_DECL) { ! if (sym->ts.interface->attr.procedure) gfc_error ("Interface '%s', used by procedure '%s' at %L, is declared " ! "in a later PROCEDURE statement", sym->ts.interface->name, sym->name,&sym->declared_at); /* Get the attributes from the interface (now resolved). */ ! if (sym->ts.interface->attr.if_source || sym->ts.interface->attr.intrinsic) { ! gfc_symbol *ifc = sym->ts.interface; ! sym->ts = ifc->ts; ! 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.recursive = ifc->attr.recursive; ! sym->attr.always_explicit = ifc->attr.always_explicit; ! copy_formal_args (sym, ifc); ! /* Copy array spec. */ ! sym->as = gfc_copy_array_spec (ifc->as); ! if (sym->as) ! { ! int i; ! for (i = 0; i < sym->as->rank; i++) ! { ! gfc_expr_replace_symbols (sym->as->lower[i], sym); ! gfc_expr_replace_symbols (sym->as->upper[i], sym); ! } ! } ! /* Copy char length. */ ! if (ifc->ts.cl) ! { ! sym->ts.cl = gfc_get_charlen(); ! sym->ts.cl->resolved = ifc->ts.cl->resolved; ! sym->ts.cl->length = gfc_copy_expr (ifc->ts.cl->length); ! gfc_expr_replace_symbols (sym->ts.cl->length, sym); ! /* Add charlen to namespace. */ ! if (sym->formal_ns) ! { ! sym->ts.cl->next = sym->formal_ns->cl_list; ! sym->formal_ns->cl_list = sym->ts.cl; ! } ! } } ! else if (sym->ts.interface->name[0] != '\0') { gfc_error ("Interface '%s' of procedure '%s' at %L must be explicit", ! sym->ts.interface->name, sym->name, &sym->declared_at); return; } } *************** resolve_symbol (gfc_symbol *sym) *** 7928,7951 **** type to avoid spurious warnings. */ if (sym->attr.flavor != FL_MODULE && sym->attr.intrinsic) { ! if (gfc_intrinsic_name (sym->name, 0)) { if (sym->ts.type != BT_UNKNOWN && gfc_option.warn_surprising) ! gfc_warning ("Type specified for intrinsic function '%s' at %L is ignored", ! sym->name, &sym->declared_at); } ! else if (gfc_intrinsic_name (sym->name, 1)) { if (sym->ts.type != BT_UNKNOWN) { ! gfc_error ("Intrinsic subroutine '%s' at %L shall not have a type specifier", ! sym->name, &sym->declared_at); return; } } else { ! gfc_error ("Intrinsic '%s' at %L does not exist", sym->name, &sym->declared_at); return; } } --- 9069,9113 ---- type to avoid spurious warnings. */ if (sym->attr.flavor != FL_MODULE && sym->attr.intrinsic) { ! gfc_intrinsic_sym* isym; ! const char* symstd; ! ! /* We already know this one is an intrinsic, so we don't call ! gfc_is_intrinsic for full checking but rather use gfc_find_function and ! gfc_find_subroutine directly to check whether it is a function or ! subroutine. */ ! ! if ((isym = gfc_find_function (sym->name))) { if (sym->ts.type != BT_UNKNOWN && gfc_option.warn_surprising) ! gfc_warning ("Type specified for intrinsic function '%s' at %L is" ! " ignored", sym->name, &sym->declared_at); } ! else if ((isym = gfc_find_subroutine (sym->name))) { if (sym->ts.type != BT_UNKNOWN) { ! gfc_error ("Intrinsic subroutine '%s' at %L shall not have a type" ! " specifier", sym->name, &sym->declared_at); return; } } else { ! gfc_error ("'%s' declared INTRINSIC at %L does not exist", ! sym->name, &sym->declared_at); ! return; ! } ! ! /* Check it is actually available in the standard settings. */ ! if (gfc_check_intrinsic_standard (isym, &symstd, false, sym->declared_at) ! == FAILURE) ! { ! gfc_error ("The intrinsic '%s' declared INTRINSIC at %L is not" ! " available in the current standard settings but %s. Use" ! " an appropriate -std=* option or enable -fall-intrinsics" ! " in order to use it.", ! sym->name, &sym->declared_at, symstd); return; } } *************** resolve_symbol (gfc_symbol *sym) *** 8044,8050 **** sym->attr.use_assoc == 0 && sym->attr.dummy == 0 && sym->attr.flavor != FL_PROCEDURE && sym->attr.flavor != FL_DERIVED) { ! try t = SUCCESS; /* First, make sure the variable is declared at the module-level scope (J3/04-007, Section 15.3). */ --- 9206,9212 ---- sym->attr.use_assoc == 0 && sym->attr.dummy == 0 && sym->attr.flavor != FL_PROCEDURE && sym->attr.flavor != FL_DERIVED) { ! gfc_try t = SUCCESS; /* First, make sure the variable is declared at the module-level scope (J3/04-007, Section 15.3). */ *************** resolve_symbol (gfc_symbol *sym) *** 8116,8121 **** --- 9278,9284 ---- module function and is not PRIVATE. */ if (sym->ts.type == BT_DERIVED && sym->ts.derived->attr.use_assoc + && sym->ns->proc_name && sym->ns->proc_name->attr.flavor == FL_MODULE) { gfc_symbol *ds; *************** resolve_symbol (gfc_symbol *sym) *** 8242,8247 **** --- 9405,9417 ---- || (a->dummy && a->intent == INTENT_OUT)) apply_default_init (sym); } + + /* If this symbol has a type-spec, check it. */ + if (sym->attr.flavor == FL_VARIABLE || sym->attr.flavor == FL_PARAMETER + || (sym->attr.flavor == FL_PROCEDURE && sym->attr.function)) + if (resolve_typespec_used (&sym->ts, &sym->declared_at, sym->name) + == FAILURE) + return; } *************** values; *** 8257,8263 **** /* Advance the values structure to point to the next value in the data list. */ ! static try next_data_value (void) { --- 9427,9433 ---- /* Advance the values structure to point to the next value in the data list. */ ! static gfc_try next_data_value (void) { *************** next_data_value (void) *** 8274,8286 **** } ! static try check_data_variable (gfc_data_variable *var, locus *where) { gfc_expr *e; mpz_t size; mpz_t offset; ! try t; ar_type mark = AR_UNKNOWN; int i; mpz_t section_index[GFC_MAX_DIMENSIONS]; --- 9444,9456 ---- } ! static gfc_try check_data_variable (gfc_data_variable *var, locus *where) { gfc_expr *e; mpz_t size; mpz_t offset; ! gfc_try t; ar_type mark = AR_UNKNOWN; int i; mpz_t section_index[GFC_MAX_DIMENSIONS]; *************** check_data_variable (gfc_data_variable * *** 8437,8453 **** } ! static try traverse_data_var (gfc_data_variable *, locus *); /* Iterate over a list of elements in a DATA statement. */ ! static try traverse_data_list (gfc_data_variable *var, locus *where) { mpz_t trip; iterator_stack frame; gfc_expr *e, *start, *end, *step; ! try retval = SUCCESS; mpz_init (frame.value); --- 9607,9623 ---- } ! static gfc_try traverse_data_var (gfc_data_variable *, locus *); /* Iterate over a list of elements in a DATA statement. */ ! static gfc_try traverse_data_list (gfc_data_variable *var, locus *where) { mpz_t trip; iterator_stack frame; gfc_expr *e, *start, *end, *step; ! gfc_try retval = SUCCESS; mpz_init (frame.value); *************** cleanup: *** 8527,8536 **** /* Type resolve variables in the variable list of a DATA statement. */ ! static try traverse_data_var (gfc_data_variable *var, locus *where) { ! try t; for (; var; var = var->next) { --- 9697,9706 ---- /* Type resolve variables in the variable list of a DATA statement. */ ! static gfc_try traverse_data_var (gfc_data_variable *var, locus *where) { ! gfc_try t; for (; var; var = var->next) { *************** traverse_data_var (gfc_data_variable *va *** 8551,8557 **** This is separate from the assignment checking because data lists should only be resolved once. */ ! static try resolve_data_variables (gfc_data_variable *d) { for (; d; d = d->next) --- 9721,9727 ---- This is separate from the assignment checking because data lists should only be resolved once. */ ! static gfc_try resolve_data_variables (gfc_data_variable *d) { for (; d; d = d->next) *************** resolve_data (gfc_data *d) *** 8609,8615 **** is storage associated with any such variable, shall not be used in the following contexts: (clients of this function). */ ! /* Determines if a variable is not 'pure', ie not assignable within a pure procedure. Returns zero if assignment is OK, nonzero if there is a problem. */ int --- 9779,9785 ---- is storage associated with any such variable, shall not be used in the following contexts: (clients of this function). */ ! /* Determines if a variable is not 'pure', i.e., not assignable within a pure procedure. Returns zero if assignment is OK, nonzero if there is a problem. */ int *************** sequence_type (gfc_typespec ts) *** 8767,8773 **** /* Resolve derived type EQUIVALENCE object. */ ! static try resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e) { gfc_symbol *d; --- 9937,9943 ---- /* Resolve derived type EQUIVALENCE object. */ ! static gfc_try resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e) { gfc_symbol *d; *************** resolve_equivalence_derived (gfc_symbol *** 8811,8817 **** /* Shall not be an object of sequence derived type containing a pointer in the structure. */ ! if (c->pointer) { gfc_error ("Derived type variable '%s' at %L with pointer " "component(s) cannot be an EQUIVALENCE object", --- 9981,9987 ---- /* Shall not be an object of sequence derived type containing a pointer in the structure. */ ! if (c->attr.pointer) { gfc_error ("Derived type variable '%s' at %L with pointer " "component(s) cannot be an EQUIVALENCE object", *************** resolve_equivalence (gfc_equiv *eq) *** 8929,8935 **** sym = e->symtree->n.sym; ! if (sym->attr.protected) cnt_protected++; if (cnt_protected > 0 && cnt_protected != object) { --- 10099,10105 ---- sym = e->symtree->n.sym; ! if (sym->attr.is_protected) cnt_protected++; if (cnt_protected > 0 && cnt_protected != object) { *************** resolve_fntype (gfc_namespace *ns) *** 9094,9105 **** } if (sym->ts.type == BT_DERIVED && !sym->ts.derived->attr.use_assoc && !gfc_check_access (sym->ts.derived->attr.access, sym->ts.derived->ns->default_access) && gfc_check_access (sym->attr.access, sym->ns->default_access)) { ! gfc_error ("PUBLIC function '%s' at %L cannot be of PRIVATE type '%s'", ! sym->name, &sym->declared_at, sym->ts.derived->name); } if (ns->entries) --- 10264,10277 ---- } if (sym->ts.type == BT_DERIVED && !sym->ts.derived->attr.use_assoc + && !sym->attr.contained && !gfc_check_access (sym->ts.derived->attr.access, sym->ts.derived->ns->default_access) && gfc_check_access (sym->attr.access, sym->ns->default_access)) { ! gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PUBLIC function '%s' at " ! "%L of PRIVATE type '%s'", sym->name, ! &sym->declared_at, sym->ts.derived->name); } if (ns->entries) *************** gfc_resolve_uops (gfc_symtree *symtree) *** 9132,9138 **** gfc_resolve_uops (symtree->left); gfc_resolve_uops (symtree->right); ! for (itr = symtree->n.uop->operator; itr; itr = itr->next) { sym = itr->sym; if (!sym->attr.function) --- 10304,10310 ---- gfc_resolve_uops (symtree->left); gfc_resolve_uops (symtree->right); ! for (itr = symtree->n.uop->op; itr; itr = itr->next) { sym = itr->sym; if (!sym->attr.function) *************** resolve_types (gfc_namespace *ns) *** 9196,9201 **** --- 10368,10385 ---- gfc_equiv *eq; gfc_namespace* old_ns = gfc_current_ns; + /* Check that all IMPLICIT types are ok. */ + if (!ns->seen_implicit_none) + { + unsigned letter; + for (letter = 0; letter != GFC_LETTERS; ++letter) + if (ns->set_flag[letter] + && resolve_typespec_used (&ns->default_type[letter], + &ns->implicit_loc[letter], + NULL) == FAILURE) + return; + } + gfc_current_ns = ns; resolve_entries (ns); diff -Nrcpad gcc-4.3.3/gcc/fortran/scanner.c gcc-4.4.0/gcc/fortran/scanner.c *** gcc-4.3.3/gcc/fortran/scanner.c Sat Jun 21 15:29:44 2008 --- gcc-4.4.0/gcc/fortran/scanner.c Fri Feb 20 15:20:38 2009 *************** *** 1,5 **** /* Character scanner. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Character scanner. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught *************** along with GCC; see the file COPYING3. *** 47,52 **** --- 47,53 ---- #include "toplev.h" #include "debug.h" #include "flags.h" + #include "cpp.h" /* Structure for holding module and include file search path. */ typedef struct gfc_directorylist *************** static gfc_linebuf *line_head, *line_tai *** 72,78 **** locus gfc_current_locus; const char *gfc_source_file; static FILE *gfc_src_file; ! static char *gfc_src_preprocessor_lines[2]; extern int pedantic; --- 73,79 ---- locus gfc_current_locus; const char *gfc_source_file; static FILE *gfc_src_file; ! static gfc_char_t *gfc_src_preprocessor_lines[2]; extern int pedantic; *************** static struct gfc_file_change *** 85,90 **** --- 86,267 ---- size_t file_changes_cur, file_changes_count; size_t file_changes_allocated; + + /* Functions dealing with our wide characters (gfc_char_t) and + sequences of such characters. */ + + int + gfc_wide_fits_in_byte (gfc_char_t c) + { + return (c <= UCHAR_MAX); + } + + static inline int + wide_is_ascii (gfc_char_t c) + { + return (gfc_wide_fits_in_byte (c) && ((unsigned char) c & ~0x7f) == 0); + } + + int + gfc_wide_is_printable (gfc_char_t c) + { + return (gfc_wide_fits_in_byte (c) && ISPRINT ((unsigned char) c)); + } + + gfc_char_t + gfc_wide_tolower (gfc_char_t c) + { + return (wide_is_ascii (c) ? (gfc_char_t) TOLOWER((unsigned char) c) : c); + } + + gfc_char_t + gfc_wide_toupper (gfc_char_t c) + { + return (wide_is_ascii (c) ? (gfc_char_t) TOUPPER((unsigned char) c) : c); + } + + int + gfc_wide_is_digit (gfc_char_t c) + { + return (c >= '0' && c <= '9'); + } + + static inline int + wide_atoi (gfc_char_t *c) + { + #define MAX_DIGITS 20 + char buf[MAX_DIGITS+1]; + int i = 0; + + while (gfc_wide_is_digit(*c) && i < MAX_DIGITS) + buf[i++] = *c++; + buf[i] = '\0'; + return atoi (buf); + } + + size_t + gfc_wide_strlen (const gfc_char_t *str) + { + size_t i; + + for (i = 0; str[i]; i++) + ; + + return i; + } + + gfc_char_t * + gfc_wide_memset (gfc_char_t *b, gfc_char_t c, size_t len) + { + size_t i; + + for (i = 0; i < len; i++) + b[i] = c; + + return b; + } + + static gfc_char_t * + wide_strcpy (gfc_char_t *dest, const gfc_char_t *src) + { + gfc_char_t *d; + + for (d = dest; (*d = *src) != '\0'; ++src, ++d) + ; + + return dest; + } + + static gfc_char_t * + wide_strchr (const gfc_char_t *s, gfc_char_t c) + { + do { + if (*s == c) + { + return CONST_CAST(gfc_char_t *, s); + } + } while (*s++); + return 0; + } + + char * + gfc_widechar_to_char (const gfc_char_t *s, int length) + { + size_t len, i; + char *res; + + if (s == NULL) + return NULL; + + /* Passing a negative length is used to indicate that length should be + calculated using gfc_wide_strlen(). */ + len = (length >= 0 ? (size_t) length : gfc_wide_strlen (s)); + res = XNEWVEC (char, len + 1); + + for (i = 0; i < len; i++) + { + gcc_assert (gfc_wide_fits_in_byte (s[i])); + res[i] = (unsigned char) s[i]; + } + + res[len] = '\0'; + return res; + } + + gfc_char_t * + gfc_char_to_widechar (const char *s) + { + size_t len, i; + gfc_char_t *res; + + if (s == NULL) + return NULL; + + len = strlen (s); + res = gfc_get_wide_string (len + 1); + + for (i = 0; i < len; i++) + res[i] = (unsigned char) s[i]; + + res[len] = '\0'; + return res; + } + + static int + wide_strncmp (const gfc_char_t *s1, const char *s2, size_t n) + { + gfc_char_t c1, c2; + + while (n-- > 0) + { + c1 = *s1++; + c2 = *s2++; + if (c1 != c2) + return (c1 > c2 ? 1 : -1); + if (c1 == '\0') + return 0; + } + return 0; + } + + int + gfc_wide_strncasecmp (const gfc_char_t *s1, const char *s2, size_t n) + { + gfc_char_t c1, c2; + + while (n-- > 0) + { + c1 = gfc_wide_tolower (*s1++); + c2 = TOLOWER (*s2++); + if (c1 != c2) + return (c1 > c2 ? 1 : -1); + if (c1 == '\0') + return 0; + } + return 0; + } + + /* Main scanner initialization. */ void *************** gfc_scanner_done_1 (void) *** 130,136 **** static void add_path_to_list (gfc_directorylist **list, const char *path, ! bool use_for_modules) { gfc_directorylist *dir; const char *p; --- 307,313 ---- static void add_path_to_list (gfc_directorylist **list, const char *path, ! bool use_for_modules, bool head) { gfc_directorylist *dir; const char *p; *************** add_path_to_list (gfc_directorylist **li *** 140,176 **** if (*p++ == '\0') return; ! dir = *list; ! if (!dir) ! dir = *list = gfc_getmem (sizeof (gfc_directorylist)); else { while (dir->next) dir = dir->next; ! dir->next = gfc_getmem (sizeof (gfc_directorylist)); dir = dir->next; } ! dir->next = NULL; dir->use_for_modules = use_for_modules; ! dir->path = gfc_getmem (strlen (p) + 2); strcpy (dir->path, p); strcat (dir->path, "/"); /* make '/' last character */ } void ! gfc_add_include_path (const char *path, bool use_for_modules) { ! add_path_to_list (&include_dirs, path, use_for_modules); } void gfc_add_intrinsic_modules_path (const char *path) { ! add_path_to_list (&intrinsic_modules_dirs, path, true); } --- 317,363 ---- if (*p++ == '\0') return; ! if (head || *list == NULL) ! { ! dir = XCNEW (gfc_directorylist); ! if (!head) ! *list = dir; ! } else { + dir = *list; while (dir->next) dir = dir->next; ! dir->next = XCNEW (gfc_directorylist); dir = dir->next; } ! dir->next = head ? *list : NULL; ! if (head) ! *list = dir; dir->use_for_modules = use_for_modules; ! dir->path = XCNEWVEC (char, strlen (p) + 2); strcpy (dir->path, p); strcat (dir->path, "/"); /* make '/' last character */ } void ! gfc_add_include_path (const char *path, bool use_for_modules, bool file_dir) { ! add_path_to_list (&include_dirs, path, use_for_modules, file_dir); ! ! /* For '#include "..."' these directories are automatically searched. */ ! if (!file_dir) ! gfc_cpp_add_include_path (xstrdup(path), true); } void gfc_add_intrinsic_modules_path (const char *path) { ! add_path_to_list (&intrinsic_modules_dirs, path, true, false); } *************** add_file_change (const char *filename, i *** 317,325 **** file_changes_allocated *= 2; else file_changes_allocated = 16; ! file_changes ! = xrealloc (file_changes, ! file_changes_allocated * sizeof (*file_changes)); } file_changes[file_changes_count].filename = filename; file_changes[file_changes_count].lb = NULL; --- 504,511 ---- file_changes_allocated *= 2; else file_changes_allocated = 16; ! file_changes = XRESIZEVEC (struct gfc_file_change, file_changes, ! file_changes_allocated); } file_changes[file_changes_count].filename = filename; file_changes[file_changes_count].lb = NULL; *************** gfc_advance_line (void) *** 406,420 **** pointer from being on the wrong line if the current statement ends prematurely. */ ! static int next_char (void) { ! int c; if (gfc_current_locus.nextc == NULL) return '\n'; ! c = (unsigned char) *gfc_current_locus.nextc++; if (c == '\0') { gfc_current_locus.nextc--; /* Remain on this line. */ --- 592,606 ---- pointer from being on the wrong line if the current statement ends prematurely. */ ! static gfc_char_t next_char (void) { ! gfc_char_t c; if (gfc_current_locus.nextc == NULL) return '\n'; ! c = *gfc_current_locus.nextc++; if (c == '\0') { gfc_current_locus.nextc--; /* Remain on this line. */ *************** next_char (void) *** 433,439 **** static void skip_comment_line (void) { ! char c; do { --- 619,625 ---- static void skip_comment_line (void) { ! gfc_char_t c; do { *************** skip_comment_line (void) *** 448,464 **** int gfc_define_undef_line (void) { /* All lines beginning with '#' are either #define or #undef. */ ! if (debug_info_level != DINFO_LEVEL_VERBOSE || gfc_peek_char () != '#') return 0; ! if (strncmp (gfc_current_locus.nextc, "#define ", 8) == 0) ! (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.lb), ! &(gfc_current_locus.nextc[8])); ! if (strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0) ! (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.lb), ! &(gfc_current_locus.nextc[7])); /* Skip the rest of the line. */ skip_comment_line (); --- 634,660 ---- int gfc_define_undef_line (void) { + char *tmp; + /* All lines beginning with '#' are either #define or #undef. */ ! if (debug_info_level != DINFO_LEVEL_VERBOSE || gfc_peek_ascii_char () != '#') return 0; ! if (wide_strncmp (gfc_current_locus.nextc, "#define ", 8) == 0) ! { ! tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[8], -1); ! (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.lb), ! tmp); ! gfc_free (tmp); ! } ! if (wide_strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0) ! { ! tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[7], -1); ! (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.lb), ! tmp); ! gfc_free (tmp); ! } /* Skip the rest of the line. */ skip_comment_line (); *************** static bool *** 476,482 **** skip_free_comments (void) { locus start; ! char c; int at_bol; for (;;) --- 672,678 ---- skip_free_comments (void) { locus start; ! gfc_char_t c; int at_bol; for (;;) *************** skip_free_comments (void) *** 514,520 **** if (((c = next_char ()) == 'm' || c == 'M') && ((c = next_char ()) == 'p' || c == 'P')) { ! if ((c = next_char ()) == ' ' || continue_flag) { while (gfc_is_whitespace (c)) c = next_char (); --- 710,717 ---- if (((c = next_char ()) == 'm' || c == 'M') && ((c = next_char ()) == 'p' || c == 'P')) { ! if ((c = next_char ()) == ' ' || c == '\t' ! || continue_flag) { while (gfc_is_whitespace (c)) c = next_char (); *************** skip_free_comments (void) *** 536,542 **** next_char (); c = next_char (); } ! if (continue_flag || c == ' ') { gfc_current_locus = old_loc; next_char (); --- 733,739 ---- next_char (); c = next_char (); } ! if (continue_flag || c == ' ' || c == '\t') { gfc_current_locus = old_loc; next_char (); *************** skip_fixed_comments (void) *** 570,576 **** { locus start; int col; ! char c; if (! gfc_at_bol ()) { --- 767,773 ---- { locus start; int col; ! gfc_char_t c; if (! gfc_at_bol ()) { *************** skip_fixed_comments (void) *** 615,620 **** --- 812,821 ---- !$|c$|*$ should be treated as 2 spaces if the characters in columns 3 to 6 are valid fixed form label columns characters. */ + if (gfc_current_locus.lb != NULL + && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) + continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); + if (gfc_option.flag_openmp) { if (next_char () == '$') *************** skip_fixed_comments (void) *** 628,638 **** c = next_char (); if (c != '\n' && ((openmp_flag && continue_flag) ! || c == ' ' || c == '0')) { ! c = next_char (); ! while (gfc_is_whitespace (c)) c = next_char (); if (c != '\n' && c != '!') { /* Canonicalize to *$omp. */ --- 829,839 ---- c = next_char (); if (c != '\n' && ((openmp_flag && continue_flag) ! || c == ' ' || c == '\t' || c == '0')) { ! do c = next_char (); + while (gfc_is_whitespace (c)); if (c != '\n' && c != '!') { /* Canonicalize to *$omp. */ *************** skip_fixed_comments (void) *** 651,656 **** --- 852,862 ---- for (col = 3; col < 6; col++, c = next_char ()) if (c == ' ') continue; + else if (c == '\t') + { + col = 6; + break; + } else if (c < '0' || c > '9') break; else *************** skip_fixed_comments (void) *** 658,664 **** if (col == 6 && c != '\n' && ((continue_flag && !digit_seen) ! || c == ' ' || c == '0')) { gfc_current_locus = start; start.nextc[0] = ' '; --- 864,870 ---- if (col == 6 && c != '\n' && ((continue_flag && !digit_seen) ! || c == ' ' || c == '\t' || c == '0')) { gfc_current_locus = start; start.nextc[0] = ' '; *************** skip_fixed_comments (void) *** 700,705 **** --- 906,914 ---- if (col != 6 && c == '!') { + if (gfc_current_locus.lb != NULL + && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) + continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); skip_comment_line (); continue; } *************** gfc_skip_comments (void) *** 731,741 **** line. The in_string flag denotes whether we're inside a character context or not. */ ! int gfc_next_char_literal (int in_string) { locus old_loc; ! int i, c, prev_openmp_flag; continue_flag = 0; --- 940,951 ---- line. The in_string flag denotes whether we're inside a character context or not. */ ! gfc_char_t gfc_next_char_literal (int in_string) { locus old_loc; ! int i, prev_openmp_flag; ! gfc_char_t c; continue_flag = 0; *************** restart: *** 821,831 **** "statement at %C", gfc_option.max_continue_free); } } - continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); /* Now find where it continues. First eat any comment lines. */ openmp_cond_flag = skip_free_comments (); if (prev_openmp_flag != openmp_flag) { gfc_current_locus = old_loc; --- 1031,1044 ---- "statement at %C", gfc_option.max_continue_free); } } /* Now find where it continues. First eat any comment lines. */ openmp_cond_flag = skip_free_comments (); + if (gfc_current_locus.lb != NULL + && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) + continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); + if (prev_openmp_flag != openmp_flag) { gfc_current_locus = old_loc; *************** restart: *** 849,855 **** { for (i = 0; i < 5; i++, c = next_char ()) { ! gcc_assert (TOLOWER (c) == "!$omp"[i]); if (i == 4) old_loc = gfc_current_locus; } --- 1062,1068 ---- { for (i = 0; i < 5; i++, c = next_char ()) { ! gcc_assert (gfc_wide_tolower (c) == (unsigned char) "!$omp"[i]); if (i == 4) old_loc = gfc_current_locus; } *************** restart: *** 922,928 **** for (i = 0; i < 5; i++) { c = next_char (); ! if (TOLOWER (c) != "*$omp"[i]) goto not_continuation; } --- 1135,1141 ---- for (i = 0; i < 5; i++) { c = next_char (); ! if (gfc_wide_tolower (c) != (unsigned char) "*$omp"[i]) goto not_continuation; } *************** restart: *** 944,950 **** } } ! if (continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); } --- 1157,1164 ---- } } ! if (gfc_current_locus.lb != NULL ! && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); } *************** done: *** 969,978 **** parsing character literals, they have to call gfc_next_char_literal(). */ ! int gfc_next_char (void) { ! int c; do { --- 1183,1192 ---- parsing character literals, they have to call gfc_next_char_literal(). */ ! gfc_char_t gfc_next_char (void) { ! gfc_char_t c; do { *************** gfc_next_char (void) *** 980,994 **** } while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c)); ! return TOLOWER (c); } ! int gfc_peek_char (void) { locus old_loc; ! int c; old_loc = gfc_current_locus; c = gfc_next_char (); --- 1194,1217 ---- } while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c)); ! return gfc_wide_tolower (c); } + char + gfc_next_ascii_char (void) + { + gfc_char_t c = gfc_next_char (); ! return (gfc_wide_fits_in_byte (c) ? (unsigned char) c ! : (unsigned char) UCHAR_MAX); ! } ! ! ! gfc_char_t gfc_peek_char (void) { locus old_loc; ! gfc_char_t c; old_loc = gfc_current_locus; c = gfc_next_char (); *************** gfc_peek_char (void) *** 998,1003 **** --- 1221,1236 ---- } + char + gfc_peek_ascii_char (void) + { + gfc_char_t c = gfc_peek_char (); + + return (gfc_wide_fits_in_byte (c) ? (unsigned char) c + : (unsigned char) UCHAR_MAX); + } + + /* Recover from an error. We try to get past the current statement and get lined up for the next. The next statement follows a '\n' or a ';'. We also assume that we are not within a character *************** gfc_peek_char (void) *** 1006,1012 **** void gfc_error_recovery (void) { ! char c, delim; if (gfc_at_eof ()) return; --- 1239,1245 ---- void gfc_error_recovery (void) { ! gfc_char_t c, delim; if (gfc_at_eof ()) return; *************** gfc_gobble_whitespace (void) *** 1053,1059 **** { static int linenum = 0; locus old_loc; ! int c; do { --- 1286,1292 ---- { static int linenum = 0; locus old_loc; ! gfc_char_t c; do { *************** gfc_gobble_whitespace (void) *** 1064,1074 **** line will be scanned multiple times. */ if (!gfc_option.warn_tabs && c == '\t') { - #ifdef USE_MAPPED_LOCATION int cur_linenum = LOCATION_LINE (gfc_current_locus.lb->location); - #else - int cur_linenum = gfc_current_locus.lb->linenum; - #endif if (cur_linenum != linenum) { linenum = cur_linenum; --- 1297,1303 ---- *************** gfc_gobble_whitespace (void) *** 1092,1097 **** --- 1321,1331 ---- In fixed mode, we expand a tab that occurs within the statement label region to expand to spaces that leave the next character in the source region. + + If first_char is not NULL, it's a pointer to a single char value holding + the first character of the line, which has already been read by the + caller. This avoids the use of ungetc(). + load_line returns whether the line was truncated. NOTE: The error machinery isn't available at this point, so we can't *************** gfc_gobble_whitespace (void) *** 1099,1111 **** parts of gfortran. */ static int ! load_line (FILE *input, char **pbuf, int *pbuflen) { static int linenum = 0, current_line = 1; int c, maxlen, i, preprocessor_flag, buflen = *pbuflen; int trunc_flag = 0, seen_comment = 0; int seen_printable = 0, seen_ampersand = 0; ! char *buffer; bool found_tab = false; /* Determine the maximum allowed line length. */ --- 1333,1345 ---- parts of gfortran. */ static int ! load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen, const int *first_char) { static int linenum = 0, current_line = 1; int c, maxlen, i, preprocessor_flag, buflen = *pbuflen; int trunc_flag = 0, seen_comment = 0; int seen_printable = 0, seen_ampersand = 0; ! gfc_char_t *buffer; bool found_tab = false; /* Determine the maximum allowed line length. */ *************** load_line (FILE *input, char **pbuf, int *** 1128,1153 **** else buflen = 132; ! *pbuf = gfc_getmem (buflen + 1); } i = 0; buffer = *pbuf; ! preprocessor_flag = 0; ! c = getc (input); ! if (c == '#') ! /* In order to not truncate preprocessor lines, we have to ! remember that this is one. */ ! preprocessor_flag = 1; ! ungetc (c, input); for (;;) { - c = getc (input); - if (c == EOF) break; if (c == '\n') { /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */ --- 1362,1387 ---- else buflen = 132; ! *pbuf = gfc_get_wide_string (buflen + 1); } i = 0; buffer = *pbuf; ! if (first_char) ! c = *first_char; ! else ! c = getc (input); ! ! /* In order to not truncate preprocessor lines, we have to ! remember that this is one. */ ! preprocessor_flag = (c == '#' ? 1 : 0); for (;;) { if (c == EOF) break; + if (c == '\n') { /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */ *************** load_line (FILE *input, char **pbuf, int *** 1164,1173 **** break; } ! if (c == '\r') ! continue; /* Gobble characters. */ ! if (c == '\0') ! continue; if (c == '&') { --- 1398,1405 ---- break; } ! if (c == '\r' || c == '\0') ! goto next_char; /* Gobble characters. */ if (c == '&') { *************** load_line (FILE *input, char **pbuf, int *** 1192,1198 **** if (c >= '1' && c <= '9') { *(buffer-1) = c; ! continue; } } --- 1424,1430 ---- if (c >= '1' && c <= '9') { *(buffer-1) = c; ! goto next_char; } } *************** load_line (FILE *input, char **pbuf, int *** 1214,1220 **** i++; } ! continue; } *buffer++ = c; --- 1446,1452 ---- i++; } ! goto next_char; } *buffer++ = c; *************** load_line (FILE *input, char **pbuf, int *** 1227,1233 **** /* Reallocate line buffer to double size to hold the overlong line. */ buflen = buflen * 2; ! *pbuf = xrealloc (*pbuf, buflen + 1); buffer = (*pbuf) + i; } } --- 1459,1465 ---- /* Reallocate line buffer to double size to hold the overlong line. */ buflen = buflen * 2; ! *pbuf = XRESIZEVEC (gfc_char_t, *pbuf, (buflen + 1)); buffer = (*pbuf) + i; } } *************** load_line (FILE *input, char **pbuf, int *** 1237,1250 **** for (;;) { c = getc (input); if (c == '\n' || c == EOF) break; trunc_flag = 1; } ! ungetc ('\n', input); } } /* Pad lines to the selected line length in fixed form. */ --- 1469,1489 ---- for (;;) { c = getc (input); + if (c == '\r') + continue; + if (c == '\n' || c == EOF) break; trunc_flag = 1; } ! c = '\n'; ! continue; } + + next_char: + c = getc (input); } /* Pad lines to the selected line length in fixed form. */ *************** get_file (const char *name, enum lc_reas *** 1273,1282 **** { gfc_file *f; ! f = gfc_getmem (sizeof (gfc_file)); ! f->filename = gfc_getmem (strlen (name) + 1); ! strcpy (f->filename, name); f->next = file_head; file_head = f; --- 1512,1520 ---- { gfc_file *f; ! f = XCNEW (gfc_file); ! f->filename = xstrdup (name); f->next = file_head; file_head = f; *************** get_file (const char *name, enum lc_reas *** 1285,1308 **** if (current_file != NULL) f->inclusion_line = current_file->line; - #ifdef USE_MAPPED_LOCATION linemap_add (line_table, reason, false, f->filename, 1); - #endif return f; } /* Deal with a line from the C preprocessor. The initial octothorp has already been seen. */ static void ! preprocessor_line (char *c) { bool flag[5]; int i, line; ! char *filename; gfc_file *f; int escaped, unescape; c++; while (*c == ' ' || *c == '\t') --- 1523,1546 ---- if (current_file != NULL) f->inclusion_line = current_file->line; linemap_add (line_table, reason, false, f->filename, 1); return f; } + /* Deal with a line from the C preprocessor. The initial octothorp has already been seen. */ static void ! preprocessor_line (gfc_char_t *c) { bool flag[5]; int i, line; ! gfc_char_t *wide_filename; gfc_file *f; int escaped, unescape; + char *filename; c++; while (*c == ' ' || *c == '\t') *************** preprocessor_line (char *c) *** 1311,1319 **** if (*c < '0' || *c > '9') goto bad_cpp_line; ! line = atoi (c); ! c = strchr (c, ' '); if (c == NULL) { /* No file name given. Set new line number. */ --- 1549,1557 ---- if (*c < '0' || *c > '9') goto bad_cpp_line; ! line = wide_atoi (c); ! c = wide_strchr (c, ' '); if (c == NULL) { /* No file name given. Set new line number. */ *************** preprocessor_line (char *c) *** 1330,1336 **** goto bad_cpp_line; ++c; ! filename = c; /* Make filename end at quote. */ unescape = 0; --- 1568,1574 ---- goto bad_cpp_line; ++c; ! wide_filename = c; /* Make filename end at quote. */ unescape = 0; *************** preprocessor_line (char *c) *** 1356,1365 **** /* Undo effects of cpp_quote_string. */ if (unescape) { ! char *s = filename; ! char *d = gfc_getmem (c - filename - unescape); ! filename = d; while (*s) { if (*s == '\\') --- 1594,1603 ---- /* Undo effects of cpp_quote_string. */ if (unescape) { ! gfc_char_t *s = wide_filename; ! gfc_char_t *d = gfc_get_wide_string (c - wide_filename - unescape); ! wide_filename = d; while (*s) { if (*s == '\\') *************** preprocessor_line (char *c) *** 1377,1393 **** for (;;) { ! c = strchr (c, ' '); if (c == NULL) break; c++; ! i = atoi (c); if (1 <= i && i <= 4) flag[i] = true; } /* Interpret flags. */ if (flag[1]) /* Starting new file. */ --- 1615,1635 ---- for (;;) { ! c = wide_strchr (c, ' '); if (c == NULL) break; c++; ! i = wide_atoi (c); if (1 <= i && i <= 4) flag[i] = true; } + /* Convert the filename in wide characters into a filename in narrow + characters. */ + filename = gfc_widechar_to_char (wide_filename, -1); + /* Interpret flags. */ if (flag[1]) /* Starting new file. */ *************** preprocessor_line (char *c) *** 1406,1421 **** current_file->filename, current_file->line, filename); if (unescape) ! gfc_free (filename); return; } add_file_change (NULL, line); current_file = current_file->up; - #ifdef USE_MAPPED_LOCATION linemap_add (line_table, LC_RENAME, false, current_file->filename, current_file->line); - #endif } /* The name of the file can be a temporary file produced by --- 1648,1662 ---- current_file->filename, current_file->line, filename); if (unescape) ! gfc_free (wide_filename); ! gfc_free (filename); return; } add_file_change (NULL, line); current_file = current_file->up; linemap_add (line_table, LC_RENAME, false, current_file->filename, current_file->line); } /* The name of the file can be a temporary file produced by *************** preprocessor_line (char *c) *** 1423,1439 **** if (strcmp (current_file->filename, filename) != 0) { ! /* FIXME: we leak the old filename because a pointer to it may be stored ! in the linemap. Alternative could be using GC or updating linemap to ! point to the new name, but there is no API for that currently. */ ! current_file->filename = gfc_getmem (strlen (filename) + 1); ! strcpy (current_file->filename, filename); } /* Set new line number. */ current_file->line = line; if (unescape) ! gfc_free (filename); return; bad_cpp_line: --- 1664,1680 ---- if (strcmp (current_file->filename, filename) != 0) { ! /* FIXME: we leak the old filename because a pointer to it may be stored ! in the linemap. Alternative could be using GC or updating linemap to ! point to the new name, but there is no API for that currently. */ ! current_file->filename = xstrdup (filename); } /* Set new line number. */ current_file->line = line; if (unescape) ! gfc_free (wide_filename); ! gfc_free (filename); return; bad_cpp_line: *************** preprocessor_line (char *c) *** 1443,1449 **** } ! static try load_file (const char *, bool); /* include_line()-- Checks a line buffer to see if it is an include line. If so, we call load_file() recursively to load the included --- 1684,1690 ---- } ! static gfc_try load_file (const char *, const char *, bool); /* include_line()-- Checks a line buffer to see if it is an include line. If so, we call load_file() recursively to load the included *************** static try load_file (const char *, bool *** 1452,1460 **** processed or true if we matched an include. */ static bool ! include_line (char *line) { ! char quote, *c, *begin, *stop; c = line; --- 1693,1702 ---- processed or true if we matched an include. */ static bool ! include_line (gfc_char_t *line) { ! gfc_char_t quote, *c, *begin, *stop; ! char *filename; c = line; *************** include_line (char *line) *** 1478,1485 **** while (*c == ' ' || *c == '\t') c++; ! if (strncasecmp (c, "include", 7)) ! return false; c += 7; while (*c == ' ' || *c == '\t') --- 1720,1727 ---- while (*c == ' ' || *c == '\t') c++; ! if (gfc_wide_strncasecmp (c, "include", 7)) ! return false; c += 7; while (*c == ' ' || *c == '\t') *************** include_line (char *line) *** 1512,1538 **** *stop = '\0'; /* It's ok to trash the buffer, as this line won't be read by anything else. */ ! load_file (begin, false); return true; } /* Load a file into memory by calling load_line until the file ends. */ ! static try ! load_file (const char *filename, bool initial) { ! char *line; gfc_linebuf *b; gfc_file *f; FILE *input; int len, line_len; bool first_line; for (f = current_file; f; f = f->up) if (strcmp (filename, f->filename) == 0) { ! gfc_error_now ("File '%s' is being included recursively", filename); return FAILURE; } --- 1754,1787 ---- *stop = '\0'; /* It's ok to trash the buffer, as this line won't be read by anything else. */ ! filename = gfc_widechar_to_char (begin, -1); ! load_file (filename, NULL, false); ! gfc_free (filename); return true; } /* Load a file into memory by calling load_line until the file ends. */ ! static gfc_try ! load_file (const char *realfilename, const char *displayedname, bool initial) { ! gfc_char_t *line; gfc_linebuf *b; gfc_file *f; FILE *input; int len, line_len; bool first_line; + const char *filename; + + filename = displayedname ? displayedname : realfilename; for (f = current_file; f; f = f->up) if (strcmp (filename, f->filename) == 0) { ! fprintf (stderr, "%s:%d: Error: File '%s' is being included " ! "recursively\n", current_file->filename, current_file->line, ! filename); return FAILURE; } *************** load_file (const char *filename, bool in *** 1544,1550 **** gfc_src_file = NULL; } else ! input = gfc_open_file (filename); if (input == NULL) { gfc_error_now ("Can't open file '%s'", filename); --- 1793,1799 ---- gfc_src_file = NULL; } else ! input = gfc_open_file (realfilename); if (input == NULL) { gfc_error_now ("Can't open file '%s'", filename); *************** load_file (const char *filename, bool in *** 1553,1562 **** } else { ! input = gfc_open_included_file (filename, false, false); if (input == NULL) { ! gfc_error_now ("Can't open included file '%s'", filename); return FAILURE; } } --- 1802,1812 ---- } else { ! input = gfc_open_included_file (realfilename, false, false); if (input == NULL) { ! fprintf (stderr, "%s:%d: Error: Can't open included file '%s'\n", ! current_file->filename, current_file->line, filename); return FAILURE; } } *************** load_file (const char *filename, bool in *** 1587,1595 **** for (;;) { ! int trunc = load_line (input, &line, &line_len); ! len = strlen (line); if (feof (input) && len == 0) break; --- 1837,1845 ---- for (;;) { ! int trunc = load_line (input, &line, &line_len, NULL); ! len = gfc_wide_strlen (line); if (feof (input) && len == 0) break; *************** load_file (const char *filename, bool in *** 1599,1615 **** FE FF is UTF-16 big endian, EF BB BF is UTF-8. */ if (first_line ! && ((line_len >= 2 && line[0] == '\xFF' && line[1] == '\xFE') ! || (line_len >= 2 && line[0] == '\xFE' && line[1] == '\xFF') ! || (line_len >= 3 && line[0] == '\xEF' && line[1] == '\xBB' ! && line[2] == '\xBF'))) { ! int n = line[1] == '\xBB' ? 3 : 2; ! char * new = gfc_getmem (line_len); ! strcpy (new, line + n); gfc_free (line); ! line = new; len -= n; } --- 1849,1868 ---- FE FF is UTF-16 big endian, EF BB BF is UTF-8. */ if (first_line ! && ((line_len >= 2 && line[0] == (unsigned char) '\xFF' ! && line[1] == (unsigned char) '\xFE') ! || (line_len >= 2 && line[0] == (unsigned char) '\xFE' ! && line[1] == (unsigned char) '\xFF') ! || (line_len >= 3 && line[0] == (unsigned char) '\xEF' ! && line[1] == (unsigned char) '\xBB' ! && line[2] == (unsigned char) '\xBF'))) { ! int n = line[1] == (unsigned char) '\xBB' ? 3 : 2; ! gfc_char_t *new_char = gfc_get_wide_string (line_len); ! wide_strcpy (new_char, &line[n]); gfc_free (line); ! line = new_char; len -= n; } *************** load_file (const char *filename, bool in *** 1622,1629 **** and #undef lines, which we need to pass to the middle-end so that it can emit correct debug info. */ if (debug_info_level == DINFO_LEVEL_VERBOSE ! && (strncmp (line, "#define ", 8) == 0 ! || strncmp (line, "#undef ", 7) == 0)) ; else { --- 1875,1882 ---- and #undef lines, which we need to pass to the middle-end so that it can emit correct debug info. */ if (debug_info_level == DINFO_LEVEL_VERBOSE ! && (wide_strncmp (line, "#define ", 8) == 0 ! || wide_strncmp (line, "#undef ", 7) == 0)) ; else { *************** load_file (const char *filename, bool in *** 1645,1661 **** /* Add line. */ ! b = gfc_getmem (gfc_linebuf_header_size + len + 1); - #ifdef USE_MAPPED_LOCATION b->location = linemap_line_start (line_table, current_file->line++, 120); - #else - b->linenum = current_file->line++; - #endif b->file = current_file; b->truncated = trunc; ! strcpy (b->line, line); if (line_head == NULL) line_head = b; --- 1898,1911 ---- /* Add line. */ ! b = (gfc_linebuf *) gfc_getmem (gfc_linebuf_header_size ! + (len + 1) * sizeof (gfc_char_t)); b->location = linemap_line_start (line_table, current_file->line++, 120); b->file = current_file; b->truncated = trunc; ! wide_strcpy (b->line, line); if (line_head == NULL) line_head = b; *************** load_file (const char *filename, bool in *** 1676,1714 **** if (!initial) add_file_change (NULL, current_file->inclusion_line + 1); current_file = current_file->up; - #ifdef USE_MAPPED_LOCATION linemap_add (line_table, LC_LEAVE, 0, NULL, 0); - #endif return SUCCESS; } /* Open a new file and start scanning from that file. Returns SUCCESS ! if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN it tries to determine the source form from the filename, defaulting to free form. */ ! try gfc_new_file (void) { ! try result; ! result = load_file (gfc_source_file, true); gfc_current_locus.lb = line_head; gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line; #if 0 /* Debugging aid. */ for (; line_head; line_head = line_head->next) ! gfc_status ("%s:%3d %s\n", ! #ifdef USE_MAPPED_LOCATION ! LOCATION_FILE (line_head->location), ! LOCATION_LINE (line_head->location), ! #else ! line_head->file->filename, ! line_head->linenum, ! #endif ! line_head->line); exit (0); #endif --- 1926,1962 ---- if (!initial) add_file_change (NULL, current_file->inclusion_line + 1); current_file = current_file->up; linemap_add (line_table, LC_LEAVE, 0, NULL, 0); return SUCCESS; } /* Open a new file and start scanning from that file. Returns SUCCESS ! if everything went OK, FAILURE otherwise. If form == FORM_UNKNOWN it tries to determine the source form from the filename, defaulting to free form. */ ! gfc_try gfc_new_file (void) { ! gfc_try result; ! if (gfc_cpp_enabled ()) ! { ! result = gfc_cpp_preprocess (gfc_source_file); ! if (!gfc_cpp_preprocess_only ()) ! result = load_file (gfc_cpp_temporary_file (), gfc_source_file, true); ! } ! else ! result = load_file (gfc_source_file, NULL, true); gfc_current_locus.lb = line_head; gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line; #if 0 /* Debugging aid. */ for (; line_head; line_head = line_head->next) ! printf ("%s:%3d %s\n", LOCATION_FILE (line_head->location), ! LOCATION_LINE (line_head->location), line_head->line); exit (0); #endif *************** unescape_filename (const char *ptr) *** 1742,1748 **** /* Undo effects of cpp_quote_string. */ s = ptr; ! d = gfc_getmem (p + 1 - ptr - unescape); ret = d; while (s != p) --- 1990,1996 ---- /* Undo effects of cpp_quote_string. */ s = ptr; ! d = XCNEWVEC (char, p + 1 - ptr - unescape); ret = d; while (s != p) *************** const char * *** 1764,1804 **** gfc_read_orig_filename (const char *filename, const char **canon_source_file) { int c, len; ! char *dirname; gfc_src_file = gfc_open_file (filename); if (gfc_src_file == NULL) return NULL; c = getc (gfc_src_file); - ungetc (c, gfc_src_file); if (c != '#') return NULL; len = 0; ! load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len); ! if (strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0) return NULL; ! filename = unescape_filename (gfc_src_preprocessor_lines[0] + 5); if (filename == NULL) return NULL; c = getc (gfc_src_file); - ungetc (c, gfc_src_file); if (c != '#') return filename; len = 0; ! load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len); ! if (strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0) return filename; ! dirname = unescape_filename (gfc_src_preprocessor_lines[1] + 5); if (dirname == NULL) return filename; --- 2012,2054 ---- gfc_read_orig_filename (const char *filename, const char **canon_source_file) { int c, len; ! char *dirname, *tmp; gfc_src_file = gfc_open_file (filename); if (gfc_src_file == NULL) return NULL; c = getc (gfc_src_file); if (c != '#') return NULL; len = 0; ! load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len, &c); ! if (wide_strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0) return NULL; ! tmp = gfc_widechar_to_char (&gfc_src_preprocessor_lines[0][5], -1); ! filename = unescape_filename (tmp); ! gfc_free (tmp); if (filename == NULL) return NULL; c = getc (gfc_src_file); if (c != '#') return filename; len = 0; ! load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len, &c); ! if (wide_strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0) return filename; ! tmp = gfc_widechar_to_char (&gfc_src_preprocessor_lines[1][5], -1); ! dirname = unescape_filename (tmp); ! gfc_free (tmp); if (dirname == NULL) return filename; *************** gfc_read_orig_filename (const char *file *** 1813,1819 **** if (! IS_ABSOLUTE_PATH (filename)) { ! char *p = gfc_getmem (len + strlen (filename)); memcpy (p, dirname, len - 2); p[len - 2] = '/'; --- 2063,2069 ---- if (! IS_ABSOLUTE_PATH (filename)) { ! char *p = XCNEWVEC (char, len + strlen (filename)); memcpy (p, dirname, len - 2); p[len - 2] = '/'; diff -Nrcpad gcc-4.3.3/gcc/fortran/simplify.c gcc-4.4.0/gcc/fortran/simplify.c *** gcc-4.3.3/gcc/fortran/simplify.c Fri Nov 14 06:14:46 2008 --- gcc-4.4.0/gcc/fortran/simplify.c Fri Mar 6 09:06:51 2009 *************** *** 1,5 **** /* Simplify intrinsic functions at compile-time. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb --- 1,5 ---- /* Simplify intrinsic functions at compile-time. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb *************** gfc_simplify_abs (gfc_expr *e) *** 256,298 **** return result; } - /* We use the processor's collating sequence, because all - systems that gfortran currently works on are ASCII. */ ! gfc_expr * ! gfc_simplify_achar (gfc_expr *e, gfc_expr *k) { gfc_expr *result; ! int c, kind; ! const char *ch; if (e->expr_type != EXPR_CONSTANT) return NULL; ! kind = get_kind (BT_CHARACTER, k, "ACHAR", gfc_default_character_kind); if (kind == -1) return &gfc_bad_expr; ! ch = gfc_extract_int (e, &c); ! ! if (ch != NULL) ! gfc_internal_error ("gfc_simplify_achar: %s", ch); ! ! if (gfc_option.warn_surprising && (c < 0 || c > 127)) ! gfc_warning ("Argument of ACHAR function at %L outside of range [0,127]", &e->where); ! result = gfc_constant_result (BT_CHARACTER, kind, &e->where); ! result->value.character.string = gfc_getmem (2); result->value.character.length = 1; ! result->value.character.string[0] = c; result->value.character.string[1] = '\0'; /* For debugger */ return result; } gfc_expr * gfc_simplify_acos (gfc_expr *x) { --- 256,328 ---- return result; } ! static gfc_expr * ! simplify_achar_char (gfc_expr *e, gfc_expr *k, const char *name, bool ascii) { gfc_expr *result; ! int kind; ! bool too_large = false; if (e->expr_type != EXPR_CONSTANT) return NULL; ! kind = get_kind (BT_CHARACTER, k, name, gfc_default_character_kind); if (kind == -1) return &gfc_bad_expr; ! if (mpz_cmp_si (e->value.integer, 0) < 0) ! { ! gfc_error ("Argument of %s function at %L is negative", name, &e->where); + return &gfc_bad_expr; + } ! if (ascii && gfc_option.warn_surprising ! && mpz_cmp_si (e->value.integer, 127) > 0) ! gfc_warning ("Argument of %s function at %L outside of range [0,127]", ! name, &e->where); ! if (kind == 1 && mpz_cmp_si (e->value.integer, 255) > 0) ! too_large = true; ! else if (kind == 4) ! { ! mpz_t t; ! mpz_init_set_ui (t, 2); ! mpz_pow_ui (t, t, 32); ! mpz_sub_ui (t, t, 1); ! if (mpz_cmp (e->value.integer, t) > 0) ! too_large = true; ! mpz_clear (t); ! } ! ! if (too_large) ! { ! gfc_error ("Argument of %s function at %L is too large for the " ! "collating sequence of kind %d", name, &e->where, kind); ! return &gfc_bad_expr; ! } + result = gfc_constant_result (BT_CHARACTER, kind, &e->where); + result->value.character.string = gfc_get_wide_string (2); result->value.character.length = 1; ! result->value.character.string[0] = mpz_get_ui (e->value.integer); result->value.character.string[1] = '\0'; /* For debugger */ return result; } + + /* We use the processor's collating sequence, because all + systems that gfortran currently works on are ASCII. */ + + gfc_expr * + gfc_simplify_achar (gfc_expr *e, gfc_expr *k) + { + return simplify_achar_char (e, k, "ACHAR", true); + } + + gfc_expr * gfc_simplify_acos (gfc_expr *x) { *************** gfc_simplify_adjustl (gfc_expr *e) *** 343,349 **** { gfc_expr *result; int count, i, len; ! char ch; if (e->expr_type != EXPR_CONSTANT) return NULL; --- 373,379 ---- { gfc_expr *result; int count, i, len; ! gfc_char_t ch; if (e->expr_type != EXPR_CONSTANT) return NULL; *************** gfc_simplify_adjustl (gfc_expr *e) *** 353,359 **** result = gfc_constant_result (BT_CHARACTER, e->ts.kind, &e->where); result->value.character.length = len; ! result->value.character.string = gfc_getmem (len + 1); for (count = 0, i = 0; i < len; ++i) { --- 383,389 ---- result = gfc_constant_result (BT_CHARACTER, e->ts.kind, &e->where); result->value.character.length = len; ! result->value.character.string = gfc_get_wide_string (len + 1); for (count = 0, i = 0; i < len; ++i) { *************** gfc_simplify_adjustr (gfc_expr *e) *** 380,386 **** { gfc_expr *result; int count, i, len; ! char ch; if (e->expr_type != EXPR_CONSTANT) return NULL; --- 410,416 ---- { gfc_expr *result; int count, i, len; ! gfc_char_t ch; if (e->expr_type != EXPR_CONSTANT) return NULL; *************** gfc_simplify_adjustr (gfc_expr *e) *** 390,396 **** result = gfc_constant_result (BT_CHARACTER, e->ts.kind, &e->where); result->value.character.length = len; ! result->value.character.string = gfc_getmem (len + 1); for (count = 0, i = len - 1; i >= 0; --i) { --- 420,426 ---- result = gfc_constant_result (BT_CHARACTER, e->ts.kind, &e->where); result->value.character.length = len; ! result->value.character.string = gfc_get_wide_string (len + 1); for (count = 0, i = len - 1; i >= 0; --i) { *************** gfc_simplify_and (gfc_expr *x, gfc_expr *** 505,518 **** { result = gfc_constant_result (BT_INTEGER, kind, &x->where); mpz_and (result->value.integer, x->value.integer, y->value.integer); } else /* BT_LOGICAL */ { result = gfc_constant_result (BT_LOGICAL, kind, &x->where); result->value.logical = x->value.logical && y->value.logical; } - - return range_check (result, "AND"); } --- 535,548 ---- { result = gfc_constant_result (BT_INTEGER, kind, &x->where); mpz_and (result->value.integer, x->value.integer, y->value.integer); + return range_check (result, "AND"); } else /* BT_LOGICAL */ { result = gfc_constant_result (BT_LOGICAL, kind, &x->where); result->value.logical = x->value.logical && y->value.logical; + return result; } } *************** gfc_simplify_atan2 (gfc_expr *y, gfc_exp *** 620,635 **** if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) return NULL; - result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - if (mpfr_sgn (y->value.real) == 0 && mpfr_sgn (x->value.real) == 0) { gfc_error ("If first argument of ATAN2 %L is zero, then the " "second argument must not be zero", &x->where); - gfc_free_expr (result); return &gfc_bad_expr; } mpfr_atan2 (result->value.real, y->value.real, x->value.real, GFC_RND_MODE); return range_check (result, "ATAN2"); --- 650,664 ---- if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) return NULL; if (mpfr_sgn (y->value.real) == 0 && mpfr_sgn (x->value.real) == 0) { gfc_error ("If first argument of ATAN2 %L is zero, then the " "second argument must not be zero", &x->where); return &gfc_bad_expr; } + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + mpfr_atan2 (result->value.real, y->value.real, x->value.real, GFC_RND_MODE); return range_check (result, "ATAN2"); *************** gfc_simplify_atan2 (gfc_expr *y, gfc_exp *** 637,642 **** --- 666,767 ---- gfc_expr * + gfc_simplify_bessel_j0 (gfc_expr *x ATTRIBUTE_UNUSED) + { + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + mpfr_j0 (result->value.real, x->value.real, GFC_RND_MODE); + + return range_check (result, "BESSEL_J0"); + } + + + gfc_expr * + gfc_simplify_bessel_j1 (gfc_expr *x ATTRIBUTE_UNUSED) + { + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + mpfr_j1 (result->value.real, x->value.real, GFC_RND_MODE); + + return range_check (result, "BESSEL_J1"); + } + + + gfc_expr * + gfc_simplify_bessel_jn (gfc_expr *order ATTRIBUTE_UNUSED, + gfc_expr *x ATTRIBUTE_UNUSED) + { + gfc_expr *result; + long n; + + if (x->expr_type != EXPR_CONSTANT || order->expr_type != EXPR_CONSTANT) + return NULL; + + n = mpz_get_si (order->value.integer); + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + mpfr_jn (result->value.real, n, x->value.real, GFC_RND_MODE); + + return range_check (result, "BESSEL_JN"); + } + + + gfc_expr * + gfc_simplify_bessel_y0 (gfc_expr *x ATTRIBUTE_UNUSED) + { + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + mpfr_y0 (result->value.real, x->value.real, GFC_RND_MODE); + + return range_check (result, "BESSEL_Y0"); + } + + + gfc_expr * + gfc_simplify_bessel_y1 (gfc_expr *x ATTRIBUTE_UNUSED) + { + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + mpfr_y1 (result->value.real, x->value.real, GFC_RND_MODE); + + return range_check (result, "BESSEL_Y1"); + } + + + gfc_expr * + gfc_simplify_bessel_yn (gfc_expr *order ATTRIBUTE_UNUSED, + gfc_expr *x ATTRIBUTE_UNUSED) + { + gfc_expr *result; + long n; + + if (x->expr_type != EXPR_CONSTANT || order->expr_type != EXPR_CONSTANT) + return NULL; + + n = mpz_get_si (order->value.integer); + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + mpfr_yn (result->value.real, n, x->value.real, GFC_RND_MODE); + + return range_check (result, "BESSEL_YN"); + } + + + gfc_expr * gfc_simplify_bit_size (gfc_expr *e) { gfc_expr *result; *************** gfc_simplify_ceiling (gfc_expr *e, gfc_e *** 683,689 **** ceil = gfc_copy_expr (e); mpfr_ceil (ceil->value.real, e->value.real); ! gfc_mpfr_to_mpz (result->value.integer, ceil->value.real); gfc_free_expr (ceil); --- 808,814 ---- ceil = gfc_copy_expr (e); mpfr_ceil (ceil->value.real, e->value.real); ! gfc_mpfr_to_mpz (result->value.integer, ceil->value.real, &e->where); gfc_free_expr (ceil); *************** gfc_simplify_ceiling (gfc_expr *e, gfc_e *** 694,728 **** gfc_expr * gfc_simplify_char (gfc_expr *e, gfc_expr *k) { ! gfc_expr *result; ! int c, kind; ! const char *ch; ! ! kind = get_kind (BT_CHARACTER, k, "CHAR", gfc_default_character_kind); ! if (kind == -1) ! return &gfc_bad_expr; ! ! if (e->expr_type != EXPR_CONSTANT) ! return NULL; ! ! ch = gfc_extract_int (e, &c); ! ! if (ch != NULL) ! gfc_internal_error ("gfc_simplify_char: %s", ch); ! ! if (c < 0 || c > UCHAR_MAX) ! gfc_error ("Argument of CHAR function at %L outside of range [0,255]", ! &e->where); ! ! result = gfc_constant_result (BT_CHARACTER, kind, &e->where); ! ! result->value.character.length = 1; ! result->value.character.string = gfc_getmem (2); ! ! result->value.character.string[0] = c; ! result->value.character.string[1] = '\0'; /* For debugger */ ! ! return result; } --- 819,825 ---- gfc_expr * gfc_simplify_char (gfc_expr *e, gfc_expr *k) { ! return simplify_achar_char (e, k, "CHAR", false); } *************** simplify_cmplx (const char *name, gfc_ex *** 780,785 **** --- 877,883 ---- if (x->is_boz) { gfc_typespec ts; + gfc_clear_ts (&ts); ts.kind = result->ts.kind; ts.type = BT_REAL; if (!gfc_convert_boz (x, &ts)) *************** simplify_cmplx (const char *name, gfc_ex *** 790,795 **** --- 888,894 ---- if (y && y->is_boz) { gfc_typespec ts; + gfc_clear_ts (&ts); ts.kind = result->ts.kind; ts.type = BT_REAL; if (!gfc_convert_boz (y, &ts)) *************** simplify_cmplx (const char *name, gfc_ex *** 801,819 **** } gfc_expr * gfc_simplify_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *k) { int kind; - if (x->expr_type != EXPR_CONSTANT - || (y != NULL && y->expr_type != EXPR_CONSTANT)) - return NULL; - kind = get_kind (BT_REAL, k, "CMPLX", gfc_default_real_kind); if (kind == -1) return &gfc_bad_expr; return simplify_cmplx ("CMPLX", x, y, kind); } --- 900,939 ---- } + /* Function called when we won't simplify an expression like CMPLX (or + COMPLEX or DCMPLX) but still want to convert BOZ arguments. */ + + static gfc_expr * + only_convert_cmplx_boz (gfc_expr *x, gfc_expr *y, int kind) + { + gfc_typespec ts; + gfc_clear_ts (&ts); + ts.type = BT_REAL; + ts.kind = kind; + + if (x->is_boz && !gfc_convert_boz (x, &ts)) + return &gfc_bad_expr; + + if (y && y->is_boz && !gfc_convert_boz (y, &ts)) + return &gfc_bad_expr; + + return NULL; + } + + gfc_expr * gfc_simplify_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *k) { int kind; kind = get_kind (BT_REAL, k, "CMPLX", gfc_default_real_kind); if (kind == -1) return &gfc_bad_expr; + if (x->expr_type != EXPR_CONSTANT + || (y != NULL && y->expr_type != EXPR_CONSTANT)) + return only_convert_cmplx_boz (x, y, kind); + return simplify_cmplx ("CMPLX", x, y, kind); } *************** gfc_simplify_complex (gfc_expr *x, gfc_e *** 823,832 **** { int kind; - if (x->expr_type != EXPR_CONSTANT - || (y != NULL && y->expr_type != EXPR_CONSTANT)) - return NULL; - if (x->ts.type == BT_INTEGER) { if (y->ts.type == BT_INTEGER) --- 943,948 ---- *************** gfc_simplify_complex (gfc_expr *x, gfc_e *** 842,847 **** --- 958,967 ---- kind = x->ts.kind; } + if (x->expr_type != EXPR_CONSTANT + || (y != NULL && y->expr_type != EXPR_CONSTANT)) + return only_convert_cmplx_boz (x, y, kind); + return simplify_cmplx ("COMPLEX", x, y, kind); } *************** gfc_simplify_cos (gfc_expr *x) *** 891,898 **** mpfr_mul (xp, xp, xq, GFC_RND_MODE); mpfr_neg (result->value.complex.i, xp, GFC_RND_MODE ); ! mpfr_clear (xp); ! mpfr_clear (xq); break; default: gfc_internal_error ("in gfc_simplify_cos(): Bad type"); --- 1011,1017 ---- mpfr_mul (xp, xp, xq, GFC_RND_MODE); mpfr_neg (result->value.complex.i, xp, GFC_RND_MODE ); ! mpfr_clears (xp, xq, NULL); break; default: gfc_internal_error ("in gfc_simplify_cos(): Bad type"); *************** gfc_simplify_dcmplx (gfc_expr *x, gfc_ex *** 925,931 **** if (x->expr_type != EXPR_CONSTANT || (y != NULL && y->expr_type != EXPR_CONSTANT)) ! return NULL; return simplify_cmplx ("DCMPLX", x, y, gfc_default_double_kind); } --- 1044,1050 ---- if (x->expr_type != EXPR_CONSTANT || (y != NULL && y->expr_type != EXPR_CONSTANT)) ! return only_convert_cmplx_boz (x, y, gfc_default_double_kind); return simplify_cmplx ("DCMPLX", x, y, gfc_default_double_kind); } *************** gfc_simplify_dcmplx (gfc_expr *x, gfc_ex *** 934,940 **** gfc_expr * gfc_simplify_dble (gfc_expr *e) { ! gfc_expr *result; if (e->expr_type != EXPR_CONSTANT) return NULL; --- 1053,1059 ---- gfc_expr * gfc_simplify_dble (gfc_expr *e) { ! gfc_expr *result = NULL; if (e->expr_type != EXPR_CONSTANT) return NULL; *************** gfc_simplify_dble (gfc_expr *e) *** 961,971 **** if (e->ts.type == BT_INTEGER && e->is_boz) { gfc_typespec ts; ts.type = BT_REAL; ts.kind = gfc_default_double_kind; result = gfc_copy_expr (e); if (!gfc_convert_boz (result, &ts)) ! return &gfc_bad_expr; } return range_check (result, "DBLE"); --- 1080,1094 ---- if (e->ts.type == BT_INTEGER && e->is_boz) { gfc_typespec ts; + gfc_clear_ts (&ts); ts.type = BT_REAL; ts.kind = gfc_default_double_kind; result = gfc_copy_expr (e); if (!gfc_convert_boz (result, &ts)) ! { ! gfc_free_expr (result); ! return &gfc_bad_expr; ! } } return range_check (result, "DBLE"); *************** gfc_simplify_dprod (gfc_expr *x, gfc_exp *** 1059,1064 **** --- 1182,1219 ---- gfc_expr * + gfc_simplify_erf (gfc_expr *x) + { + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + + mpfr_erf (result->value.real, x->value.real, GFC_RND_MODE); + + return range_check (result, "ERF"); + } + + + gfc_expr * + gfc_simplify_erfc (gfc_expr *x) + { + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + + mpfr_erfc (result->value.real, x->value.real, GFC_RND_MODE); + + return range_check (result, "ERFC"); + } + + + gfc_expr * gfc_simplify_epsilon (gfc_expr *e) { gfc_expr *result; *************** gfc_simplify_exp (gfc_expr *x) *** 1100,1107 **** mpfr_mul (result->value.complex.r, xq, xp, GFC_RND_MODE); mpfr_sin (xp, x->value.complex.i, GFC_RND_MODE); mpfr_mul (result->value.complex.i, xq, xp, GFC_RND_MODE); ! mpfr_clear (xp); ! mpfr_clear (xq); break; default: --- 1255,1261 ---- mpfr_mul (result->value.complex.r, xq, xp, GFC_RND_MODE); mpfr_sin (xp, x->value.complex.i, GFC_RND_MODE); mpfr_mul (result->value.complex.i, xq, xp, GFC_RND_MODE); ! mpfr_clears (xp, xq, NULL); break; default: *************** gfc_simplify_float (gfc_expr *a) *** 1149,1161 **** if (a->is_boz) { gfc_typespec ts; ts.type = BT_REAL; ts.kind = gfc_default_real_kind; result = gfc_copy_expr (a); if (!gfc_convert_boz (result, &ts)) ! return &gfc_bad_expr; } else result = gfc_int2real (a, gfc_default_real_kind); --- 1303,1319 ---- if (a->is_boz) { gfc_typespec ts; + gfc_clear_ts (&ts); ts.type = BT_REAL; ts.kind = gfc_default_real_kind; result = gfc_copy_expr (a); if (!gfc_convert_boz (result, &ts)) ! { ! gfc_free_expr (result); ! return &gfc_bad_expr; ! } } else result = gfc_int2real (a, gfc_default_real_kind); *************** gfc_simplify_floor (gfc_expr *e, gfc_exp *** 1183,1189 **** mpfr_init (floor); mpfr_floor (floor, e->value.real); ! gfc_mpfr_to_mpz (result->value.integer, floor); mpfr_clear (floor); --- 1341,1347 ---- mpfr_init (floor); mpfr_floor (floor, e->value.real); ! gfc_mpfr_to_mpz (result->value.integer, floor, &e->where); mpfr_clear (floor); *************** gfc_simplify_fraction (gfc_expr *x) *** 1202,1215 **** result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); - if (mpfr_sgn (x->value.real) == 0) { mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); return result; } mpfr_init (exp); mpfr_init (absv); mpfr_init (pow2); --- 1360,1372 ---- result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where); if (mpfr_sgn (x->value.real) == 0) { mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); return result; } + gfc_set_model_kind (x->ts.kind); mpfr_init (exp); mpfr_init (absv); mpfr_init (pow2); *************** gfc_simplify_fraction (gfc_expr *x) *** 1224,1232 **** mpfr_div (result->value.real, absv, pow2, GFC_RND_MODE); ! mpfr_clear (exp); ! mpfr_clear (absv); ! mpfr_clear (pow2); return range_check (result, "FRACTION"); } --- 1381,1387 ---- mpfr_div (result->value.real, absv, pow2, GFC_RND_MODE); ! mpfr_clears (exp, absv, pow2, NULL); return range_check (result, "FRACTION"); } *************** gfc_simplify_gamma (gfc_expr *x) *** 1242,1249 **** result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); - mpfr_gamma (result->value.real, x->value.real, GFC_RND_MODE); return range_check (result, "GAMMA"); --- 1397,1402 ---- *************** gfc_simplify_huge (gfc_expr *e) *** 1277,1282 **** --- 1430,1450 ---- return result; } + + gfc_expr * + gfc_simplify_hypot (gfc_expr *x, gfc_expr *y) + { + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + mpfr_hypot (result->value.real, x->value.real, y->value.real, GFC_RND_MODE); + return range_check (result, "HYPOT"); + } + + /* We use the processor's collating sequence, because all systems that gfortran currently works on are ASCII. */ *************** gfc_expr * *** 1284,1290 **** gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind) { gfc_expr *result; ! int index; if (e->expr_type != EXPR_CONSTANT) return NULL; --- 1452,1458 ---- gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind) { gfc_expr *result; ! gfc_char_t index; if (e->expr_type != EXPR_CONSTANT) return NULL; *************** gfc_simplify_iachar (gfc_expr *e, gfc_ex *** 1295,1301 **** return &gfc_bad_expr; } ! index = (unsigned char) e->value.character.string[0]; if (gfc_option.warn_surprising && index > 127) gfc_warning ("Argument of IACHAR function at %L outside of range 0..127", --- 1463,1469 ---- return &gfc_bad_expr; } ! index = e->value.character.string[0]; if (gfc_option.warn_surprising && index > 127) gfc_warning ("Argument of IACHAR function at %L outside of range 0..127", *************** gfc_simplify_ibclr (gfc_expr *x, gfc_exp *** 1360,1366 **** convert_mpz_to_signed (result->value.integer, gfc_integer_kinds[k].bit_size); ! return range_check (result, "IBCLR"); } --- 1528,1534 ---- convert_mpz_to_signed (result->value.integer, gfc_integer_kinds[k].bit_size); ! return result; } *************** gfc_simplify_ibits (gfc_expr *x, gfc_exp *** 1401,1408 **** } result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); ! bits = gfc_getmem (bitsize * sizeof (int)); for (i = 0; i < bitsize; i++) bits[i] = 0; --- 1569,1578 ---- } result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + convert_mpz_to_unsigned (result->value.integer, + gfc_integer_kinds[k].bit_size); ! bits = XCNEWVEC (int, bitsize); for (i = 0; i < bitsize; i++) bits[i] = 0; *************** gfc_simplify_ibits (gfc_expr *x, gfc_exp *** 1422,1428 **** gfc_free (bits); ! return range_check (result, "IBITS"); } --- 1592,1601 ---- gfc_free (bits); ! convert_mpz_to_signed (result->value.integer, ! gfc_integer_kinds[k].bit_size); ! ! return result; } *************** gfc_simplify_ibset (gfc_expr *x, gfc_exp *** 1460,1466 **** convert_mpz_to_signed (result->value.integer, gfc_integer_kinds[k].bit_size); ! return range_check (result, "IBSET"); } --- 1633,1639 ---- convert_mpz_to_signed (result->value.integer, gfc_integer_kinds[k].bit_size); ! return result; } *************** gfc_expr * *** 1468,1474 **** gfc_simplify_ichar (gfc_expr *e, gfc_expr *kind) { gfc_expr *result; ! int index; if (e->expr_type != EXPR_CONSTANT) return NULL; --- 1641,1647 ---- gfc_simplify_ichar (gfc_expr *e, gfc_expr *kind) { gfc_expr *result; ! gfc_char_t index; if (e->expr_type != EXPR_CONSTANT) return NULL; *************** gfc_simplify_ichar (gfc_expr *e, gfc_exp *** 1479,1488 **** return &gfc_bad_expr; } ! index = (unsigned char) e->value.character.string[0]; ! ! if (index < 0 || index > UCHAR_MAX) ! gfc_internal_error("Argument of ICHAR at %L out of range", &e->where); if ((result = int_expr_with_kind (index, kind, "ICHAR")) == NULL) return &gfc_bad_expr; --- 1652,1658 ---- return &gfc_bad_expr; } ! index = e->value.character.string[0]; if ((result = int_expr_with_kind (index, kind, "ICHAR")) == NULL) return &gfc_bad_expr; *************** gfc_simplify_index (gfc_expr *x, gfc_exp *** 1515,1521 **** int back, len, lensub; int i, j, k, count, index = 0, start; ! if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) return NULL; if (b != NULL && b->value.logical != 0) --- 1685,1692 ---- int back, len, lensub; int i, j, k, count, index = 0, start; ! if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT ! || ( b != NULL && b->expr_type != EXPR_CONSTANT)) return NULL; if (b != NULL && b->value.logical != 0) *************** done: *** 1655,1661 **** gfc_expr * gfc_simplify_int (gfc_expr *e, gfc_expr *k) { ! gfc_expr *rpart, *rtrunc, *result; int kind; kind = get_kind (BT_INTEGER, k, "INT", gfc_default_integer_kind); --- 1826,1832 ---- gfc_expr * gfc_simplify_int (gfc_expr *e, gfc_expr *k) { ! gfc_expr *result = NULL; int kind; kind = get_kind (BT_INTEGER, k, "INT", gfc_default_integer_kind); *************** gfc_simplify_int (gfc_expr *e, gfc_expr *** 1665,1697 **** if (e->expr_type != EXPR_CONSTANT) return NULL; - result = gfc_constant_result (BT_INTEGER, kind, &e->where); - switch (e->ts.type) { case BT_INTEGER: ! mpz_set (result->value.integer, e->value.integer); break; case BT_REAL: ! rtrunc = gfc_copy_expr (e); ! mpfr_trunc (rtrunc->value.real, e->value.real); ! gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real); ! gfc_free_expr (rtrunc); break; case BT_COMPLEX: ! rpart = gfc_complex2real (e, kind); ! rtrunc = gfc_copy_expr (rpart); ! mpfr_trunc (rtrunc->value.real, rpart->value.real); ! gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real); ! gfc_free_expr (rpart); ! gfc_free_expr (rtrunc); break; default: gfc_error ("Argument of INT at %L is not a valid type", &e->where); - gfc_free_expr (result); return &gfc_bad_expr; } --- 1836,1857 ---- if (e->expr_type != EXPR_CONSTANT) return NULL; switch (e->ts.type) { case BT_INTEGER: ! result = gfc_int2int (e, kind); break; case BT_REAL: ! result = gfc_real2int (e, kind); break; case BT_COMPLEX: ! result = gfc_complex2int (e, kind); break; default: gfc_error ("Argument of INT at %L is not a valid type", &e->where); return &gfc_bad_expr; } *************** gfc_simplify_int (gfc_expr *e, gfc_expr *** 1700,1739 **** static gfc_expr * ! gfc_simplify_intconv (gfc_expr *e, int kind, const char *name) { ! gfc_expr *rpart, *rtrunc, *result; if (e->expr_type != EXPR_CONSTANT) return NULL; - result = gfc_constant_result (BT_INTEGER, kind, &e->where); - switch (e->ts.type) { case BT_INTEGER: ! mpz_set (result->value.integer, e->value.integer); break; case BT_REAL: ! rtrunc = gfc_copy_expr (e); ! mpfr_trunc (rtrunc->value.real, e->value.real); ! gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real); ! gfc_free_expr (rtrunc); break; case BT_COMPLEX: ! rpart = gfc_complex2real (e, kind); ! rtrunc = gfc_copy_expr (rpart); ! mpfr_trunc (rtrunc->value.real, rpart->value.real); ! gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real); ! gfc_free_expr (rpart); ! gfc_free_expr (rtrunc); break; default: gfc_error ("Argument of %s at %L is not a valid type", name, &e->where); - gfc_free_expr (result); return &gfc_bad_expr; } --- 1860,1888 ---- static gfc_expr * ! simplify_intconv (gfc_expr *e, int kind, const char *name) { ! gfc_expr *result = NULL; if (e->expr_type != EXPR_CONSTANT) return NULL; switch (e->ts.type) { case BT_INTEGER: ! result = gfc_int2int (e, kind); break; case BT_REAL: ! result = gfc_real2int (e, kind); break; case BT_COMPLEX: ! result = gfc_complex2int (e, kind); break; default: gfc_error ("Argument of %s at %L is not a valid type", name, &e->where); return &gfc_bad_expr; } *************** gfc_simplify_intconv (gfc_expr *e, int k *** 1744,1764 **** gfc_expr * gfc_simplify_int2 (gfc_expr *e) { ! return gfc_simplify_intconv (e, 2, "INT2"); } gfc_expr * gfc_simplify_int8 (gfc_expr *e) { ! return gfc_simplify_intconv (e, 8, "INT8"); } gfc_expr * gfc_simplify_long (gfc_expr *e) { ! return gfc_simplify_intconv (e, 4, "LONG"); } --- 1893,1913 ---- gfc_expr * gfc_simplify_int2 (gfc_expr *e) { ! return simplify_intconv (e, 2, "INT2"); } gfc_expr * gfc_simplify_int8 (gfc_expr *e) { ! return simplify_intconv (e, 8, "INT8"); } gfc_expr * gfc_simplify_long (gfc_expr *e) { ! return simplify_intconv (e, 4, "LONG"); } *************** gfc_simplify_ifix (gfc_expr *e) *** 1776,1782 **** rtrunc = gfc_copy_expr (e); mpfr_trunc (rtrunc->value.real, e->value.real); ! gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real); gfc_free_expr (rtrunc); return range_check (result, "IFIX"); --- 1925,1931 ---- rtrunc = gfc_copy_expr (e); mpfr_trunc (rtrunc->value.real, e->value.real); ! gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real, &e->where); gfc_free_expr (rtrunc); return range_check (result, "IFIX"); *************** gfc_simplify_idint (gfc_expr *e) *** 1797,1803 **** rtrunc = gfc_copy_expr (e); mpfr_trunc (rtrunc->value.real, e->value.real); ! gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real); gfc_free_expr (rtrunc); return range_check (result, "IDINT"); --- 1946,1952 ---- rtrunc = gfc_copy_expr (e); mpfr_trunc (rtrunc->value.real, e->value.real); ! gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real, &e->where); gfc_free_expr (rtrunc); return range_check (result, "IDINT"); *************** gfc_simplify_ishft (gfc_expr *e, gfc_exp *** 1858,1864 **** return range_check (result, "ISHFT"); } ! bits = gfc_getmem (isize * sizeof (int)); for (i = 0; i < isize; i++) bits[i] = mpz_tstbit (e->value.integer, i); --- 2007,2013 ---- return range_check (result, "ISHFT"); } ! bits = XCNEWVEC (int, isize); for (i = 0; i < isize; i++) bits[i] = mpz_tstbit (e->value.integer, i); *************** gfc_simplify_ishftc (gfc_expr *e, gfc_ex *** 1962,1968 **** convert_mpz_to_unsigned (result->value.integer, isize); ! bits = gfc_getmem (ssize * sizeof (int)); for (i = 0; i < ssize; i++) bits[i] = mpz_tstbit (e->value.integer, i); --- 2111,2117 ---- convert_mpz_to_unsigned (result->value.integer, isize); ! bits = XCNEWVEC (int, ssize); for (i = 0; i < ssize; i++) bits[i] = mpz_tstbit (e->value.integer, i); *************** gfc_simplify_kind (gfc_expr *e) *** 2029,2035 **** static gfc_expr * simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper, ! gfc_array_spec *as) { gfc_expr *l, *u, *result; int k; --- 2178,2184 ---- static gfc_expr * simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper, ! gfc_array_spec *as, gfc_ref *ref) { gfc_expr *l, *u, *result; int k; *************** simplify_bound_dim (gfc_expr *array, gfc *** 2043,2055 **** return NULL; } - /* Then, we need to know the extent of the given dimension. */ - l = as->lower[d-1]; - u = as->upper[d-1]; - - if (l->expr_type != EXPR_CONSTANT || u->expr_type != EXPR_CONSTANT) - return NULL; - k = get_kind (BT_INTEGER, kind, upper ? "UBOUND" : "LBOUND", gfc_default_integer_kind); if (k == -1) --- 2192,2197 ---- *************** simplify_bound_dim (gfc_expr *array, gfc *** 2057,2077 **** result = gfc_constant_result (BT_INTEGER, k, &array->where); ! if (mpz_cmp (l->value.integer, u->value.integer) > 0) { ! /* Zero extent. */ ! if (upper) ! mpz_set_si (result->value.integer, 0); else ! mpz_set_si (result->value.integer, 1); } else { - /* Nonzero extent. */ if (upper) ! mpz_set (result->value.integer, u->value.integer); else ! mpz_set (result->value.integer, l->value.integer); } return range_check (result, upper ? "UBOUND" : "LBOUND"); --- 2199,2241 ---- result = gfc_constant_result (BT_INTEGER, k, &array->where); ! ! /* Then, we need to know the extent of the given dimension. */ ! if (ref->u.ar.type == AR_FULL) { ! l = as->lower[d-1]; ! u = as->upper[d-1]; ! ! if (l->expr_type != EXPR_CONSTANT || u->expr_type != EXPR_CONSTANT) ! return NULL; ! ! if (mpz_cmp (l->value.integer, u->value.integer) > 0) ! { ! /* Zero extent. */ ! if (upper) ! mpz_set_si (result->value.integer, 0); ! else ! mpz_set_si (result->value.integer, 1); ! } else ! { ! /* Nonzero extent. */ ! if (upper) ! mpz_set (result->value.integer, u->value.integer); ! else ! mpz_set (result->value.integer, l->value.integer); ! } } else { if (upper) ! { ! if (gfc_ref_dimen_size (&ref->u.ar, d-1, &result->value.integer) ! != SUCCESS) ! return NULL; ! } else ! mpz_set_si (result->value.integer, (long int) 1); } return range_check (result, upper ? "UBOUND" : "LBOUND"); *************** simplify_bound (gfc_expr *array, gfc_exp *** 2104,2114 **** case AR_FULL: /* We're done because 'as' has already been set in the previous iteration. */ ! goto done; - case AR_SECTION: case AR_UNKNOWN: return NULL; } gcc_unreachable (); --- 2268,2284 ---- case AR_FULL: /* We're done because 'as' has already been set in the previous iteration. */ ! if (!ref->next) ! goto done; ! ! /* Fall through. */ case AR_UNKNOWN: return NULL; + + case AR_SECTION: + as = ref->u.ar.as; + goto done; } gcc_unreachable (); *************** simplify_bound (gfc_expr *array, gfc_exp *** 2148,2154 **** /* Simplify the bounds for each dimension. */ for (d = 0; d < array->rank; d++) { ! bounds[d] = simplify_bound_dim (array, kind, d + 1, upper, as); if (bounds[d] == NULL || bounds[d] == &gfc_bad_expr) { int j; --- 2318,2324 ---- /* Simplify the bounds for each dimension. */ for (d = 0; d < array->rank; d++) { ! bounds[d] = simplify_bound_dim (array, kind, d + 1, upper, as, ref); if (bounds[d] == NULL || bounds[d] == &gfc_bad_expr) { int j; *************** simplify_bound (gfc_expr *array, gfc_exp *** 2167,2173 **** k = get_kind (BT_INTEGER, kind, upper ? "UBOUND" : "LBOUND", gfc_default_integer_kind); if (k == -1) ! return &gfc_bad_expr; e->ts.kind = k; /* The result is a rank 1 array; its size is the rank of the first --- 2337,2346 ---- k = get_kind (BT_INTEGER, kind, upper ? "UBOUND" : "LBOUND", gfc_default_integer_kind); if (k == -1) ! { ! gfc_free_expr (e); ! return &gfc_bad_expr; ! } e->ts.kind = k; /* The result is a rank 1 array; its size is the rank of the first *************** simplify_bound (gfc_expr *array, gfc_exp *** 2211,2217 **** return &gfc_bad_expr; } ! return simplify_bound_dim (array, kind, d, upper, as); } } --- 2384,2390 ---- return &gfc_bad_expr; } ! return simplify_bound_dim (array, kind, d, upper, as, ref); } } *************** gfc_simplify_lbound (gfc_expr *array, gf *** 2224,2229 **** --- 2397,2426 ---- gfc_expr * + gfc_simplify_leadz (gfc_expr *e) + { + gfc_expr *result; + unsigned long lz, bs; + int i; + + if (e->expr_type != EXPR_CONSTANT) + return NULL; + + i = gfc_validate_kind (e->ts.type, e->ts.kind, false); + bs = gfc_integer_kinds[i].bit_size; + if (mpz_cmp_si (e->value.integer, 0) == 0) + lz = bs; + else + lz = bs - mpz_sizeinbase (e->value.integer, 2); + + result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind, &e->where); + mpz_set_ui (result->value.integer, lz); + + return result; + } + + + gfc_expr * gfc_simplify_len (gfc_expr *e, gfc_expr *kind) { gfc_expr *result; *************** gfc_simplify_len_trim (gfc_expr *e, gfc_ *** 2281,2289 **** } gfc_expr * ! gfc_simplify_lgamma (gfc_expr *x __attribute__((unused))) { - #if MPFR_VERSION >= MPFR_VERSION_NUM(2,3,0) gfc_expr *result; int sg; --- 2478,2485 ---- } gfc_expr * ! gfc_simplify_lgamma (gfc_expr *x ATTRIBUTE_UNUSED) { gfc_expr *result; int sg; *************** gfc_simplify_lgamma (gfc_expr *x __attri *** 2292,2305 **** result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); - mpfr_lgamma (result->value.real, &sg, x->value.real, GFC_RND_MODE); return range_check (result, "LGAMMA"); - #else - return NULL; - #endif } --- 2488,2496 ---- *************** gfc_simplify_log (gfc_expr *x) *** 2355,2361 **** result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); switch (x->ts.type) { --- 2546,2551 ---- *************** gfc_simplify_log (gfc_expr *x) *** 2381,2386 **** --- 2571,2577 ---- return &gfc_bad_expr; } + gfc_set_model_kind (x->ts.kind); mpfr_init (xr); mpfr_init (xi); *************** gfc_simplify_log (gfc_expr *x) *** 2393,2400 **** mpfr_sqrt (xr, xr, GFC_RND_MODE); mpfr_log (result->value.complex.r, xr, GFC_RND_MODE); ! mpfr_clear (xr); ! mpfr_clear (xi); break; --- 2584,2590 ---- mpfr_sqrt (xr, xr, GFC_RND_MODE); mpfr_log (result->value.complex.r, xr, GFC_RND_MODE); ! mpfr_clears (xr, xi, NULL); break; *************** gfc_simplify_log10 (gfc_expr *x) *** 2414,2421 **** if (x->expr_type != EXPR_CONSTANT) return NULL; - gfc_set_model_kind (x->ts.kind); - if (mpfr_sgn (x->value.real) <= 0) { gfc_error ("Argument of LOG10 at %L cannot be less than or equal " --- 2604,2609 ---- *************** gfc_simplify_logical (gfc_expr *e, gfc_e *** 2452,2513 **** } /* Selects bewteen current value and extremum for simplify_min_max and simplify_minval_maxval. */ static void min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign) { ! switch (arg->ts.type) ! { ! case BT_INTEGER: ! if (mpz_cmp (arg->value.integer, ! extremum->value.integer) * sign > 0) ! mpz_set (extremum->value.integer, arg->value.integer); ! break; ! case BT_REAL: ! /* We need to use mpfr_min and mpfr_max to treat NaN properly. */ ! if (sign > 0) ! mpfr_max (extremum->value.real, extremum->value.real, arg->value.real, GFC_RND_MODE); ! else ! mpfr_min (extremum->value.real, extremum->value.real, arg->value.real, GFC_RND_MODE); ! break; ! case BT_CHARACTER: #define LENGTH(x) ((x)->value.character.length) #define STRING(x) ((x)->value.character.string) ! if (LENGTH(extremum) < LENGTH(arg)) ! { ! char * tmp = STRING(extremum); ! STRING(extremum) = gfc_getmem (LENGTH(arg) + 1); ! memcpy (STRING(extremum), tmp, LENGTH(extremum)); ! memset (&STRING(extremum)[LENGTH(extremum)], ' ', ! LENGTH(arg) - LENGTH(extremum)); ! STRING(extremum)[LENGTH(arg)] = '\0'; /* For debugger */ ! LENGTH(extremum) = LENGTH(arg); ! gfc_free (tmp); ! } ! if (gfc_compare_string (arg, extremum) * sign > 0) ! { ! gfc_free (STRING(extremum)); ! STRING(extremum) = gfc_getmem (LENGTH(extremum) + 1); ! memcpy (STRING(extremum), STRING(arg), LENGTH(arg)); ! memset (&STRING(extremum)[LENGTH(arg)], ' ', ! LENGTH(extremum) - LENGTH(arg)); ! STRING(extremum)[LENGTH(extremum)] = '\0'; /* For debugger */ ! } #undef LENGTH #undef STRING ! break; ! ! default: ! gfc_internal_error ("simplify_min_max(): Bad type in arglist"); ! } } --- 2640,2714 ---- } + gfc_expr * + gfc_simplify_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask) + { + if (tsource->expr_type != EXPR_CONSTANT + || fsource->expr_type != EXPR_CONSTANT + || mask->expr_type != EXPR_CONSTANT) + return NULL; + + return gfc_copy_expr (mask->value.logical ? tsource : fsource); + } + + /* Selects bewteen current value and extremum for simplify_min_max and simplify_minval_maxval. */ static void min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign) { ! switch (arg->ts.type) ! { ! case BT_INTEGER: ! if (mpz_cmp (arg->value.integer, ! extremum->value.integer) * sign > 0) ! mpz_set (extremum->value.integer, arg->value.integer); ! break; ! case BT_REAL: ! /* We need to use mpfr_min and mpfr_max to treat NaN properly. */ ! if (sign > 0) ! mpfr_max (extremum->value.real, extremum->value.real, arg->value.real, GFC_RND_MODE); ! else ! mpfr_min (extremum->value.real, extremum->value.real, arg->value.real, GFC_RND_MODE); ! break; ! case BT_CHARACTER: #define LENGTH(x) ((x)->value.character.length) #define STRING(x) ((x)->value.character.string) ! if (LENGTH(extremum) < LENGTH(arg)) ! { ! gfc_char_t *tmp = STRING(extremum); ! STRING(extremum) = gfc_get_wide_string (LENGTH(arg) + 1); ! memcpy (STRING(extremum), tmp, ! LENGTH(extremum) * sizeof (gfc_char_t)); ! gfc_wide_memset (&STRING(extremum)[LENGTH(extremum)], ' ', ! LENGTH(arg) - LENGTH(extremum)); ! STRING(extremum)[LENGTH(arg)] = '\0'; /* For debugger */ ! LENGTH(extremum) = LENGTH(arg); ! gfc_free (tmp); ! } ! if (gfc_compare_string (arg, extremum) * sign > 0) ! { ! gfc_free (STRING(extremum)); ! STRING(extremum) = gfc_get_wide_string (LENGTH(extremum) + 1); ! memcpy (STRING(extremum), STRING(arg), ! LENGTH(arg) * sizeof (gfc_char_t)); ! gfc_wide_memset (&STRING(extremum)[LENGTH(arg)], ' ', ! LENGTH(extremum) - LENGTH(arg)); ! STRING(extremum)[LENGTH(extremum)] = '\0'; /* For debugger */ ! } #undef LENGTH #undef STRING ! break; ! default: ! gfc_internal_error ("simplify_min_max(): Bad type in arglist"); ! } } *************** simplify_min_max (gfc_expr *expr, int si *** 2541,2547 **** continue; } ! min_max_choose (arg->expr, extremum->expr, sign); /* Delete the extra constant argument. */ if (last == NULL) --- 2742,2748 ---- continue; } ! min_max_choose (arg->expr, extremum->expr, sign); /* Delete the extra constant argument. */ if (last == NULL) *************** gfc_expr * *** 2683,2689 **** gfc_simplify_mod (gfc_expr *a, gfc_expr *p) { gfc_expr *result; ! mpfr_t quot, iquot, term; int kind; if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT) --- 2884,2890 ---- gfc_simplify_mod (gfc_expr *a, gfc_expr *p) { gfc_expr *result; ! mpfr_t tmp; int kind; if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT) *************** gfc_simplify_mod (gfc_expr *a, gfc_expr *** 2715,2732 **** } gfc_set_model_kind (kind); ! mpfr_init (quot); ! mpfr_init (iquot); ! mpfr_init (term); ! ! mpfr_div (quot, a->value.real, p->value.real, GFC_RND_MODE); ! mpfr_trunc (iquot, quot); ! mpfr_mul (term, iquot, p->value.real, GFC_RND_MODE); ! mpfr_sub (result->value.real, a->value.real, term, GFC_RND_MODE); ! ! mpfr_clear (quot); ! mpfr_clear (iquot); ! mpfr_clear (term); break; default: --- 2916,2927 ---- } gfc_set_model_kind (kind); ! mpfr_init (tmp); ! mpfr_div (tmp, a->value.real, p->value.real, GFC_RND_MODE); ! mpfr_trunc (tmp, tmp); ! mpfr_mul (tmp, tmp, p->value.real, GFC_RND_MODE); ! mpfr_sub (result->value.real, a->value.real, tmp, GFC_RND_MODE); ! mpfr_clear (tmp); break; default: *************** gfc_expr * *** 2741,2747 **** gfc_simplify_modulo (gfc_expr *a, gfc_expr *p) { gfc_expr *result; ! mpfr_t quot, iquot, term; int kind; if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT) --- 2936,2942 ---- gfc_simplify_modulo (gfc_expr *a, gfc_expr *p) { gfc_expr *result; ! mpfr_t tmp; int kind; if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT) *************** gfc_simplify_modulo (gfc_expr *a, gfc_ex *** 2775,2792 **** } gfc_set_model_kind (kind); ! mpfr_init (quot); ! mpfr_init (iquot); ! mpfr_init (term); ! ! mpfr_div (quot, a->value.real, p->value.real, GFC_RND_MODE); ! mpfr_floor (iquot, quot); ! mpfr_mul (term, iquot, p->value.real, GFC_RND_MODE); ! mpfr_sub (result->value.real, a->value.real, term, GFC_RND_MODE); ! ! mpfr_clear (quot); ! mpfr_clear (iquot); ! mpfr_clear (term); break; default: --- 2970,2981 ---- } gfc_set_model_kind (kind); ! mpfr_init (tmp); ! mpfr_div (tmp, a->value.real, p->value.real, GFC_RND_MODE); ! mpfr_floor (tmp, tmp); ! mpfr_mul (tmp, tmp, p->value.real, GFC_RND_MODE); ! mpfr_sub (result->value.real, a->value.real, tmp, GFC_RND_MODE); ! mpfr_clear (tmp); break; default: *************** gfc_simplify_nearest (gfc_expr *x, gfc_e *** 2826,2832 **** return &gfc_bad_expr; } - gfc_set_model_kind (x->ts.kind); result = gfc_copy_expr (x); /* Save current values of emin and emax. */ --- 3015,3020 ---- *************** gfc_simplify_nearest (gfc_expr *x, gfc_e *** 2838,2843 **** --- 3026,3032 ---- mpfr_set_emin ((mp_exp_t) gfc_real_kinds[kind].min_exponent - mpfr_get_prec(result->value.real) + 1); mpfr_set_emax ((mp_exp_t) gfc_real_kinds[kind].max_exponent - 1); + mpfr_check_range (result->value.real, 0, GMP_RNDU); if (mpfr_sgn (s->value.real) > 0) { *************** gfc_simplify_nearest (gfc_expr *x, gfc_e *** 2858,2863 **** --- 3047,3053 ---- if (mpfr_nan_p (result->value.real) && gfc_option.flag_range_check) { gfc_error ("Result of NEAREST is NaN at %L", &result->where); + gfc_free_expr (result); return &gfc_bad_expr; } *************** simplify_nint (const char *name, gfc_exp *** 2884,2890 **** mpfr_round (itrunc->value.real, e->value.real); ! gfc_mpfr_to_mpz (result->value.integer, itrunc->value.real); gfc_free_expr (itrunc); --- 3074,3080 ---- mpfr_round (itrunc->value.real, e->value.real); ! gfc_mpfr_to_mpz (result->value.integer, itrunc->value.real, &e->where); gfc_free_expr (itrunc); *************** gfc_simplify_new_line (gfc_expr *e) *** 2898,2904 **** gfc_expr *result; result = gfc_constant_result (BT_CHARACTER, e->ts.kind, &e->where); ! result->value.character.string = gfc_getmem (2); result->value.character.length = 1; result->value.character.string[0] = '\n'; result->value.character.string[1] = '\0'; /* For debugger */ --- 3088,3094 ---- gfc_expr *result; result = gfc_constant_result (BT_CHARACTER, e->ts.kind, &e->where); ! result->value.character.string = gfc_get_wide_string (2); result->value.character.length = 1; result->value.character.string[0] = '\n'; result->value.character.string[1] = '\0'; /* For debugger */ *************** gfc_simplify_or (gfc_expr *x, gfc_expr * *** 2968,2981 **** { result = gfc_constant_result (BT_INTEGER, kind, &x->where); mpz_ior (result->value.integer, x->value.integer, y->value.integer); } else /* BT_LOGICAL */ { result = gfc_constant_result (BT_LOGICAL, kind, &x->where); result->value.logical = x->value.logical || y->value.logical; } - - return range_check (result, "OR"); } --- 3158,3171 ---- { result = gfc_constant_result (BT_INTEGER, kind, &x->where); mpz_ior (result->value.integer, x->value.integer, y->value.integer); + return range_check (result, "OR"); } else /* BT_LOGICAL */ { result = gfc_constant_result (BT_LOGICAL, kind, &x->where); result->value.logical = x->value.logical || y->value.logical; + return result; } } *************** gfc_simplify_range (gfc_expr *e) *** 3056,3062 **** gfc_expr * gfc_simplify_real (gfc_expr *e, gfc_expr *k) { ! gfc_expr *result; int kind; if (e->ts.type == BT_COMPLEX) --- 3246,3252 ---- gfc_expr * gfc_simplify_real (gfc_expr *e, gfc_expr *k) { ! gfc_expr *result = NULL; int kind; if (e->ts.type == BT_COMPLEX) *************** gfc_simplify_real (gfc_expr *e, gfc_expr *** 3093,3104 **** if (e->ts.type == BT_INTEGER && e->is_boz) { gfc_typespec ts; ts.type = BT_REAL; ts.kind = kind; result = gfc_copy_expr (e); if (!gfc_convert_boz (result, &ts)) ! return &gfc_bad_expr; } return range_check (result, "REAL"); } --- 3283,3299 ---- if (e->ts.type == BT_INTEGER && e->is_boz) { gfc_typespec ts; + gfc_clear_ts (&ts); ts.type = BT_REAL; ts.kind = kind; result = gfc_copy_expr (e); if (!gfc_convert_boz (result, &ts)) ! { ! gfc_free_expr (result); ! return &gfc_bad_expr; ! } } + return range_check (result, "REAL"); } *************** gfc_simplify_repeat (gfc_expr *e, gfc_ex *** 3218,3236 **** if (ncop == 0) { ! result->value.character.string = gfc_getmem (1); result->value.character.length = 0; result->value.character.string[0] = '\0'; return result; } result->value.character.length = nlen; ! result->value.character.string = gfc_getmem (nlen + 1); for (i = 0; i < ncop; i++) for (j = 0; j < len; j++) ! result->value.character.string[j + i * len] ! = e->value.character.string[j]; result->value.character.string[nlen] = '\0'; /* For debugger */ return result; --- 3413,3430 ---- if (ncop == 0) { ! result->value.character.string = gfc_get_wide_string (1); result->value.character.length = 0; result->value.character.string[0] = '\0'; return result; } result->value.character.length = nlen; ! result->value.character.string = gfc_get_wide_string (nlen + 1); for (i = 0; i < ncop; i++) for (j = 0; j < len; j++) ! result->value.character.string[j+i*len]= e->value.character.string[j]; result->value.character.string[nlen] = '\0'; /* For debugger */ return result; *************** is_constant_array_expr (gfc_expr *e) *** 3250,3258 **** if (e->expr_type != EXPR_ARRAY || !gfc_is_constant_expr (e)) return false; - if (e->value.constructor == NULL) - return false; - for (c = e->value.constructor; c; c = c->next) if (c->expr->expr_type != EXPR_CONSTANT) return false; --- 3444,3449 ---- *************** gfc_simplify_reshape (gfc_expr *source, *** 3308,3320 **** goto bad_reshape; } - gfc_free_expr (e); - if (rank >= GFC_MAX_DIMENSIONS) { gfc_error ("Too many dimensions in shape specification for RESHAPE " "at %L", &e->where); ! goto bad_reshape; } --- 3499,3509 ---- goto bad_reshape; } if (rank >= GFC_MAX_DIMENSIONS) { gfc_error ("Too many dimensions in shape specification for RESHAPE " "at %L", &e->where); ! gfc_free_expr (e); goto bad_reshape; } *************** gfc_simplify_reshape (gfc_expr *source, *** 3322,3330 **** --- 3511,3521 ---- { gfc_error ("Shape specification at %L cannot be negative", &e->where); + gfc_free_expr (e); goto bad_reshape; } + gfc_free_expr (e); rank++; } *************** gfc_simplify_reshape (gfc_expr *source, *** 3364,3375 **** goto bad_reshape; } - gfc_free_expr (e); - if (order[i] < 1 || order[i] > rank) { gfc_error ("ORDER parameter of RESHAPE at %L is out of range", &e->where); goto bad_reshape; } --- 3555,3565 ---- goto bad_reshape; } if (order[i] < 1 || order[i] > rank) { gfc_error ("ORDER parameter of RESHAPE at %L is out of range", &e->where); + gfc_free_expr (e); goto bad_reshape; } *************** gfc_simplify_reshape (gfc_expr *source, *** 3379,3387 **** --- 3569,3580 ---- { gfc_error ("Invalid permutation in ORDER parameter at %L", &e->where); + gfc_free_expr (e); goto bad_reshape; } + gfc_free_expr (e); + x[order[i]] = 1; } } *************** gfc_simplify_reshape (gfc_expr *source, *** 3421,3427 **** } if (mpz_cmp_ui (index, INT_MAX) > 0) ! gfc_internal_error ("Reshaped array too large at %L", &e->where); j = mpz_get_ui (index); --- 3614,3620 ---- } if (mpz_cmp_ui (index, INT_MAX) > 0) ! gfc_internal_error ("Reshaped array too large at %C"); j = mpz_get_ui (index); *************** gfc_simplify_scale (gfc_expr *x, gfc_exp *** 3553,3558 **** --- 3746,3752 ---- || mpz_cmp_si (i->value.integer, -exp_range - 2) < 0) { gfc_error ("Result of SCALE overflows its kind at %L", &result->where); + gfc_free_expr (result); return &gfc_bad_expr; } *************** gfc_simplify_scale (gfc_expr *x, gfc_exp *** 3578,3590 **** else mpfr_mul (result->value.real, x->value.real, scale, GFC_RND_MODE); ! mpfr_clear (scale); ! mpfr_clear (radix); return range_check (result, "SCALE"); } gfc_expr * gfc_simplify_scan (gfc_expr *e, gfc_expr *c, gfc_expr *b, gfc_expr *kind) { --- 3772,3828 ---- else mpfr_mul (result->value.real, x->value.real, scale, GFC_RND_MODE); ! mpfr_clears (scale, radix, NULL); return range_check (result, "SCALE"); } + /* Variants of strspn and strcspn that operate on wide characters. */ + + static size_t + wide_strspn (const gfc_char_t *s1, const gfc_char_t *s2) + { + size_t i = 0; + const gfc_char_t *c; + + while (s1[i]) + { + for (c = s2; *c; c++) + { + if (s1[i] == *c) + break; + } + if (*c == '\0') + break; + i++; + } + + return i; + } + + static size_t + wide_strcspn (const gfc_char_t *s1, const gfc_char_t *s2) + { + size_t i = 0; + const gfc_char_t *c; + + while (s1[i]) + { + for (c = s2; *c; c++) + { + if (s1[i] == *c) + break; + } + if (*c) + break; + i++; + } + + return i; + } + + gfc_expr * gfc_simplify_scan (gfc_expr *e, gfc_expr *c, gfc_expr *b, gfc_expr *kind) { *************** gfc_simplify_scan (gfc_expr *e, gfc_expr *** 3618,3625 **** { if (back == 0) { ! indx = strcspn (e->value.character.string, c->value.character.string) ! + 1; if (indx > len) indx = 0; } --- 3856,3863 ---- { if (back == 0) { ! indx = wide_strcspn (e->value.character.string, ! c->value.character.string) + 1; if (indx > len) indx = 0; } *************** gfc_simplify_scan (gfc_expr *e, gfc_expr *** 3645,3650 **** --- 3883,3912 ---- gfc_expr * + gfc_simplify_selected_char_kind (gfc_expr *e) + { + int kind; + gfc_expr *result; + + if (e->expr_type != EXPR_CONSTANT) + return NULL; + + if (gfc_compare_with_Cstring (e, "ascii", false) == 0 + || gfc_compare_with_Cstring (e, "default", false) == 0) + kind = 1; + else if (gfc_compare_with_Cstring (e, "iso_10646", false) == 0) + kind = 4; + else + kind = -1; + + result = gfc_int_expr (kind); + result->where = e->where; + + return result; + } + + + gfc_expr * gfc_simplify_selected_int_kind (gfc_expr *e) { int i, kind, range; *************** gfc_simplify_set_exponent (gfc_expr *x, *** 3740,3753 **** result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); - if (mpfr_sgn (x->value.real) == 0) { mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); return result; } mpfr_init (absv); mpfr_init (log2); mpfr_init (exp); --- 4002,4014 ---- result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where); if (mpfr_sgn (x->value.real) == 0) { mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); return result; } + gfc_set_model_kind (x->ts.kind); mpfr_init (absv); mpfr_init (log2); mpfr_init (exp); *************** gfc_simplify_set_exponent (gfc_expr *x, *** 3769,3778 **** exp2 = (unsigned long) mpz_get_d (i->value.integer); mpfr_mul_2exp (result->value.real, frac, exp2, GFC_RND_MODE); ! mpfr_clear (absv); ! mpfr_clear (log2); ! mpfr_clear (pow2); ! mpfr_clear (frac); return range_check (result, "SET_EXPONENT"); } --- 4030,4036 ---- exp2 = (unsigned long) mpz_get_d (i->value.integer); mpfr_mul_2exp (result->value.real, frac, exp2, GFC_RND_MODE); ! mpfr_clears (absv, log2, pow2, frac, NULL); return range_check (result, "SET_EXPONENT"); } *************** gfc_simplify_shape (gfc_expr *source) *** 3785,3791 **** gfc_expr *result, *e, *f; gfc_array_ref *ar; int n; ! try t; if (source->rank == 0) return gfc_start_constructor (BT_INTEGER, gfc_default_integer_kind, --- 4043,4049 ---- gfc_expr *result, *e, *f; gfc_array_ref *ar; int n; ! gfc_try t; if (source->rank == 0) return gfc_start_constructor (BT_INTEGER, gfc_default_integer_kind, *************** gfc_simplify_sin (gfc_expr *x) *** 3933,3940 **** mpfr_sinh (xq, x->value.complex.i, GFC_RND_MODE); mpfr_mul (result->value.complex.i, xp, xq, GFC_RND_MODE); ! mpfr_clear (xp); ! mpfr_clear (xq); break; default: --- 4191,4197 ---- mpfr_sinh (xq, x->value.complex.i, GFC_RND_MODE); mpfr_mul (result->value.complex.i, xp, xq, GFC_RND_MODE); ! mpfr_clears (xp, xq, NULL); break; default: *************** gfc_simplify_sqrt (gfc_expr *e) *** 4110,4120 **** gfc_internal_error ("invalid complex argument of SQRT at %L", &e->where); ! mpfr_clear (s); ! mpfr_clear (t); ! mpfr_clear (ac); ! mpfr_clear (ad); ! mpfr_clear (w); break; --- 4367,4373 ---- gfc_internal_error ("invalid complex argument of SQRT at %L", &e->where); ! mpfr_clears (s, t, ac, ad, w, NULL); break; *************** gfc_simplify_tiny (gfc_expr *e) *** 4183,4188 **** --- 4436,4462 ---- gfc_expr * + gfc_simplify_trailz (gfc_expr *e) + { + gfc_expr *result; + unsigned long tz, bs; + int i; + + if (e->expr_type != EXPR_CONSTANT) + return NULL; + + i = gfc_validate_kind (e->ts.type, e->ts.kind, false); + bs = gfc_integer_kinds[i].bit_size; + tz = mpz_scan1 (e->value.integer, 0); + + result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind, &e->where); + mpz_set_ui (result->value.integer, MIN (tz, bs)); + + return result; + } + + + gfc_expr * gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size) { gfc_expr *result; *************** gfc_simplify_transfer (gfc_expr *source, *** 4267,4272 **** --- 4541,4547 ---- /* Allocate the buffer to store the binary version of the source. */ buffer_size = MAX (source_size, result_size); buffer = (unsigned char*)alloca (buffer_size); + memset (buffer, 0, buffer_size); /* Now write source to the buffer. */ gfc_target_encode_expr (source, buffer, buffer_size); *************** gfc_simplify_trim (gfc_expr *e) *** 4302,4308 **** lentrim = len - count; result->value.character.length = lentrim; ! result->value.character.string = gfc_getmem (lentrim + 1); for (i = 0; i < lentrim; i++) result->value.character.string[i] = e->value.character.string[i]; --- 4577,4583 ---- lentrim = len - count; result->value.character.length = lentrim; ! result->value.character.string = gfc_get_wide_string (lentrim + 1); for (i = 0; i < lentrim; i++) result->value.character.string[i] = e->value.character.string[i]; *************** gfc_simplify_verify (gfc_expr *s, gfc_ex *** 4359,4366 **** return result; } ! index = strspn (s->value.character.string, set->value.character.string) ! + 1; if (index > len) index = 0; --- 4634,4641 ---- return result; } ! index = wide_strspn (s->value.character.string, ! set->value.character.string) + 1; if (index > len) index = 0; *************** gfc_simplify_xor (gfc_expr *x, gfc_expr *** 4404,4418 **** { result = gfc_constant_result (BT_INTEGER, kind, &x->where); mpz_xor (result->value.integer, x->value.integer, y->value.integer); } else /* BT_LOGICAL */ { result = gfc_constant_result (BT_LOGICAL, kind, &x->where); result->value.logical = (x->value.logical && !y->value.logical) || (!x->value.logical && y->value.logical); } - return range_check (result, "XOR"); } --- 4679,4694 ---- { result = gfc_constant_result (BT_INTEGER, kind, &x->where); mpz_xor (result->value.integer, x->value.integer, y->value.integer); + return range_check (result, "XOR"); } else /* BT_LOGICAL */ { result = gfc_constant_result (BT_LOGICAL, kind, &x->where); result->value.logical = (x->value.logical && !y->value.logical) || (!x->value.logical && y->value.logical); + return result; } } *************** gfc_convert_constant (gfc_expr *e, bt ty *** 4594,4596 **** --- 4870,4956 ---- return result; } + + + /* Function for converting character constants. */ + gfc_expr * + gfc_convert_char_constant (gfc_expr *e, bt type ATTRIBUTE_UNUSED, int kind) + { + gfc_expr *result; + int i; + + if (!gfc_is_constant_expr (e)) + return NULL; + + if (e->expr_type == EXPR_CONSTANT) + { + /* Simple case of a scalar. */ + result = gfc_constant_result (BT_CHARACTER, kind, &e->where); + if (result == NULL) + return &gfc_bad_expr; + + result->value.character.length = e->value.character.length; + result->value.character.string + = gfc_get_wide_string (e->value.character.length + 1); + memcpy (result->value.character.string, e->value.character.string, + (e->value.character.length + 1) * sizeof (gfc_char_t)); + + /* Check we only have values representable in the destination kind. */ + for (i = 0; i < result->value.character.length; i++) + if (!gfc_check_character_range (result->value.character.string[i], + kind)) + { + gfc_error ("Character '%s' in string at %L cannot be converted " + "into character kind %d", + gfc_print_wide_char (result->value.character.string[i]), + &e->where, kind); + return &gfc_bad_expr; + } + + return result; + } + else if (e->expr_type == EXPR_ARRAY) + { + /* For an array constructor, we convert each constructor element. */ + gfc_constructor *head = NULL, *tail = NULL, *c; + + for (c = e->value.constructor; c; c = c->next) + { + if (head == NULL) + head = tail = gfc_get_constructor (); + else + { + tail->next = gfc_get_constructor (); + tail = tail->next; + } + + tail->where = c->where; + tail->expr = gfc_convert_char_constant (c->expr, type, kind); + if (tail->expr == &gfc_bad_expr) + { + tail->expr = NULL; + return &gfc_bad_expr; + } + + if (tail->expr == NULL) + { + gfc_free_constructor (head); + return NULL; + } + } + + result = gfc_get_expr (); + result->ts.type = type; + result->ts.kind = kind; + result->expr_type = EXPR_ARRAY; + result->value.constructor = head; + result->shape = gfc_copy_shape (e->shape, e->rank); + result->where = e->where; + result->rank = e->rank; + result->ts.cl = e->ts.cl; + + return result; + } + else + return NULL; + } diff -Nrcpad gcc-4.3.3/gcc/fortran/st.c gcc-4.4.0/gcc/fortran/st.c *** gcc-4.3.3/gcc/fortran/st.c Mon Sep 3 17:09:20 2007 --- gcc-4.4.0/gcc/fortran/st.c Sun Aug 31 10:00:30 2008 *************** *** 1,5 **** /* Build executable statement trees. ! Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Build executable statement trees. ! Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Andy Vaught *************** gfc_get_code (void) *** 48,54 **** { gfc_code *c; ! c = gfc_getmem (sizeof (gfc_code)); c->loc = gfc_current_locus; return c; } --- 48,54 ---- { gfc_code *c; ! c = XCNEW (gfc_code); c->loc = gfc_current_locus; return c; } *************** gfc_get_code (void) *** 58,77 **** its tail, returning a pointer to the new tail. */ gfc_code * ! gfc_append_code (gfc_code *tail, gfc_code *new) { if (tail != NULL) { while (tail->next != NULL) tail = tail->next; ! tail->next = new; } ! while (new->next != NULL) ! new = new->next; ! return new; } --- 58,77 ---- its tail, returning a pointer to the new tail. */ gfc_code * ! gfc_append_code (gfc_code *tail, gfc_code *new_code) { if (tail != NULL) { while (tail->next != NULL) tail = tail->next; ! tail->next = new_code; } ! while (new_code->next != NULL) ! new_code = new_code->next; ! return new_code; } *************** gfc_free_statement (gfc_code *p) *** 108,113 **** --- 108,114 ---- case EXEC_ARITHMETIC_IF: break; + case EXEC_COMPCALL: case EXEC_CALL: case EXEC_ASSIGN_CALL: gfc_free_actual_arglist (p->ext.actual); *************** gfc_free_statement (gfc_code *p) *** 146,151 **** --- 147,156 ---- gfc_free_inquire (p->ext.inquire); break; + case EXEC_WAIT: + gfc_free_wait (p->ext.wait); + break; + case EXEC_READ: case EXEC_WRITE: gfc_free_dt (p->ext.dt); *************** gfc_free_statement (gfc_code *p) *** 167,172 **** --- 172,178 ---- case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: + case EXEC_OMP_TASK: case EXEC_OMP_WORKSHARE: case EXEC_OMP_PARALLEL_WORKSHARE: gfc_free_omp_clauses (p->ext.omp_clauses); *************** gfc_free_statement (gfc_code *p) *** 185,190 **** --- 191,197 ---- case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_END_NOWAIT: + case EXEC_OMP_TASKWAIT: break; default: diff -Nrcpad gcc-4.3.3/gcc/fortran/symbol.c gcc-4.4.0/gcc/fortran/symbol.c *** gcc-4.3.3/gcc/fortran/symbol.c Tue Sep 23 06:25:39 2008 --- gcc-4.4.0/gcc/fortran/symbol.c Fri Jan 9 23:47:55 2009 *************** *** 1,5 **** /* Maintain binary trees of symbols. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Maintain binary trees of symbols. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught *************** along with GCC; see the file COPYING3. *** 25,30 **** --- 25,31 ---- #include "flags.h" #include "gfortran.h" #include "parse.h" + #include "match.h" /* Strings for all symbol attributes. We use these for dumping the *************** gfc_clear_new_implicit (void) *** 145,151 **** /* Prepare for a new implicit range. Sets flags in new_flag[]. */ ! try gfc_add_new_implicit_range (int c1, int c2) { int i; --- 146,152 ---- /* Prepare for a new implicit range. Sets flags in new_flag[]. */ ! gfc_try gfc_add_new_implicit_range (int c1, int c2) { int i; *************** gfc_add_new_implicit_range (int c1, int *** 172,178 **** /* Add a matched implicit range for gfc_set_implicit(). Check if merging the new implicit types back into the existing types will work. */ ! try gfc_merge_new_implicit (gfc_typespec *ts) { int i; --- 173,179 ---- /* Add a matched implicit range for gfc_set_implicit(). Check if merging the new implicit types back into the existing types will work. */ ! gfc_try gfc_merge_new_implicit (gfc_typespec *ts) { int i; *************** gfc_merge_new_implicit (gfc_typespec *ts *** 187,200 **** { if (new_flag[i]) { - if (gfc_current_ns->set_flag[i]) { gfc_error ("Letter %c already has an IMPLICIT type at %C", i + 'A'); return FAILURE; } gfc_current_ns->default_type[i] = *ts; gfc_current_ns->set_flag[i] = 1; } } --- 188,202 ---- { if (new_flag[i]) { if (gfc_current_ns->set_flag[i]) { gfc_error ("Letter %c already has an IMPLICIT type at %C", i + 'A'); return FAILURE; } + gfc_current_ns->default_type[i] = *ts; + gfc_current_ns->implicit_loc[i] = gfc_current_locus; gfc_current_ns->set_flag[i] = 1; } } *************** gfc_get_default_type (gfc_symbol *sym, g *** 212,223 **** letter = sym->name[0]; if (gfc_option.flag_allow_leading_underscore && letter == '_') ! gfc_internal_error ("Option -fallow_leading_underscore is for use only by " "gfortran developers, and should not be used for " "implicitly typed variables"); if (letter < 'a' || letter > 'z') ! gfc_internal_error ("gfc_get_default_type(): Bad symbol"); if (ns == NULL) ns = gfc_current_ns; --- 214,225 ---- letter = sym->name[0]; if (gfc_option.flag_allow_leading_underscore && letter == '_') ! gfc_internal_error ("Option -fallow-leading-underscore is for use only by " "gfortran developers, and should not be used for " "implicitly typed variables"); if (letter < 'a' || letter > 'z') ! gfc_internal_error ("gfc_get_default_type(): Bad symbol '%s'",sym->name); if (ns == NULL) ns = gfc_current_ns; *************** gfc_get_default_type (gfc_symbol *sym, g *** 230,236 **** letter of its name. Fails if the letter in question has no default type. */ ! try gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns) { gfc_typespec *ts; --- 232,238 ---- letter of its name. Fails if the letter in question has no default type. */ ! gfc_try gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns) { gfc_typespec *ts; *************** gfc_set_default_type (gfc_symbol *sym, i *** 255,260 **** --- 257,268 ---- sym->ts = *ts; sym->attr.implicit_type = 1; + if (ts->cl) + { + sym->ts.cl = gfc_get_charlen (); + *sym->ts.cl = *ts->cl; + } + if (sym->attr.is_bind_c == 1) { /* BIND(C) variables should not be implicitly declared. */ *************** gfc_set_default_type (gfc_symbol *sym, i *** 272,278 **** { /* Dummy args to a BIND(C) routine may not be interoperable if they are implicitly typed. */ ! gfc_warning_now ("Implicity declared variable '%s' at %L may not " "be C interoperable but it is a dummy argument to " "the BIND(C) procedure '%s' at %L", sym->name, &(sym->declared_at), sym->ns->proc_name->name, --- 280,286 ---- { /* Dummy args to a BIND(C) routine may not be interoperable if they are implicitly typed. */ ! gfc_warning_now ("Implicitly declared variable '%s' at %L may not " "be C interoperable but it is a dummy argument to " "the BIND(C) procedure '%s' at %L", sym->name, &(sym->declared_at), sym->ns->proc_name->name, *************** gfc_check_function_type (gfc_namespace * *** 336,342 **** goto conflict_std;\ } ! static try check_conflict (symbol_attribute *attr, const char *name, locus *where) { static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER", --- 344,350 ---- goto conflict_std;\ } ! static gfc_try check_conflict (symbol_attribute *attr, const char *name, locus *where) { static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER", *************** check_conflict (symbol_attribute *attr, *** 344,357 **** *intent_in = "INTENT(IN)", *intrinsic = "INTRINSIC", *intent_out = "INTENT(OUT)", *intent_inout = "INTENT(INOUT)", *allocatable = "ALLOCATABLE", *elemental = "ELEMENTAL", ! *private = "PRIVATE", *recursive = "RECURSIVE", *in_common = "COMMON", *result = "RESULT", *in_namelist = "NAMELIST", ! *public = "PUBLIC", *optional = "OPTIONAL", *entry = "ENTRY", *function = "FUNCTION", *subroutine = "SUBROUTINE", *dimension = "DIMENSION", *in_equivalence = "EQUIVALENCE", *use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER", *cray_pointee = "CRAY POINTEE", *data = "DATA", *value = "VALUE", ! *volatile_ = "VOLATILE", *protected = "PROTECTED", *is_bind_c = "BIND(C)", *procedure = "PROCEDURE"; static const char *threadprivate = "THREADPRIVATE"; --- 352,365 ---- *intent_in = "INTENT(IN)", *intrinsic = "INTRINSIC", *intent_out = "INTENT(OUT)", *intent_inout = "INTENT(INOUT)", *allocatable = "ALLOCATABLE", *elemental = "ELEMENTAL", ! *privat = "PRIVATE", *recursive = "RECURSIVE", *in_common = "COMMON", *result = "RESULT", *in_namelist = "NAMELIST", ! *publik = "PUBLIC", *optional = "OPTIONAL", *entry = "ENTRY", *function = "FUNCTION", *subroutine = "SUBROUTINE", *dimension = "DIMENSION", *in_equivalence = "EQUIVALENCE", *use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER", *cray_pointee = "CRAY POINTEE", *data = "DATA", *value = "VALUE", ! *volatile_ = "VOLATILE", *is_protected = "PROTECTED", *is_bind_c = "BIND(C)", *procedure = "PROCEDURE"; static const char *threadprivate = "THREADPRIVATE"; *************** check_conflict (symbol_attribute *attr, *** 383,391 **** if (attr->optional) a1 = optional; if (attr->access == ACCESS_PRIVATE) ! a1 = private; if (attr->access == ACCESS_PUBLIC) ! a1 = public; if (attr->intent != INTENT_UNKNOWN) a1 = intent; --- 391,399 ---- if (attr->optional) a1 = optional; if (attr->access == ACCESS_PRIVATE) ! a1 = privat; if (attr->access == ACCESS_PUBLIC) ! a1 = publik; if (attr->intent != INTENT_UNKNOWN) a1 = intent; *************** check_conflict (symbol_attribute *attr, *** 410,422 **** case FL_BLOCK_DATA: case FL_MODULE: case FL_LABEL: - case FL_PROCEDURE: case FL_DERIVED: case FL_PARAMETER: a1 = gfc_code2string (flavors, attr->flavor); a2 = save; goto conflict; case FL_VARIABLE: case FL_NAMELIST: default: --- 418,432 ---- case FL_BLOCK_DATA: case FL_MODULE: case FL_LABEL: case FL_DERIVED: case FL_PARAMETER: a1 = gfc_code2string (flavors, attr->flavor); a2 = save; goto conflict; + case FL_PROCEDURE: + /* Conflicts between SAVE and PROCEDURE will be checked at + resolution stage, see "resolve_fl_procedure". */ case FL_VARIABLE: case FL_NAMELIST: default: *************** check_conflict (symbol_attribute *attr, *** 434,445 **** conf (target, external); conf (target, intrinsic); ! conf (external, dimension); /* See Fortran 95's R504. */ conf (external, intrinsic); conf (entry, intrinsic); ! if ((attr->if_source && !attr->procedure) || attr->contained) { conf (external, subroutine); conf (external, function); --- 444,457 ---- conf (target, external); conf (target, intrinsic); ! ! if (!attr->if_source) ! conf (external, dimension); /* See Fortran 95's R504. */ conf (external, intrinsic); conf (entry, intrinsic); ! if ((attr->if_source == IFSRC_DECL && !attr->procedure) || attr->contained) { conf (external, subroutine); conf (external, function); *************** check_conflict (symbol_attribute *attr, *** 533,541 **** goto conflict; } ! conf (protected, intrinsic) ! conf (protected, external) ! conf (protected, in_common) conf (volatile_, intrinsic) conf (volatile_, external) --- 545,553 ---- goto conflict; } ! conf (is_protected, intrinsic) ! conf (is_protected, external) ! conf (is_protected, in_common) conf (volatile_, intrinsic) conf (volatile_, external) *************** check_conflict (symbol_attribute *attr, *** 550,567 **** conf (procedure, allocatable) conf (procedure, dimension) conf (procedure, intrinsic) ! conf (procedure, protected) conf (procedure, target) conf (procedure, value) conf (procedure, volatile_) conf (procedure, entry) - /* TODO: Implement procedure pointers. */ - if (attr->procedure && attr->pointer) - { - gfc_error ("Fortran 2003: Procedure pointers at %L are " - "not yet implemented in gfortran", where); - return FAILURE; - } a1 = gfc_code2string (flavors, attr->flavor); --- 562,572 ---- conf (procedure, allocatable) conf (procedure, dimension) conf (procedure, intrinsic) ! conf (procedure, is_protected) conf (procedure, target) conf (procedure, value) conf (procedure, volatile_) conf (procedure, entry) a1 = gfc_code2string (flavors, attr->flavor); *************** check_conflict (symbol_attribute *attr, *** 584,590 **** conf2 (dummy); conf2 (volatile_); conf2 (pointer); ! conf2 (protected); conf2 (target); conf2 (external); conf2 (intrinsic); --- 589,595 ---- conf2 (dummy); conf2 (volatile_); conf2 (pointer); ! conf2 (is_protected); conf2 (target); conf2 (external); conf2 (intrinsic); *************** check_conflict (symbol_attribute *attr, *** 595,612 **** conf2 (function); conf2 (subroutine); conf2 (threadprivate); break; case FL_VARIABLE: case FL_NAMELIST: break; case FL_PROCEDURE: ! conf2 (intent); if (attr->subroutine) { - conf2 (pointer); conf2 (target); conf2 (allocatable); conf2 (result); --- 600,635 ---- conf2 (function); conf2 (subroutine); conf2 (threadprivate); + + if (attr->access == ACCESS_PUBLIC || attr->access == ACCESS_PRIVATE) + { + a2 = attr->access == ACCESS_PUBLIC ? publik : privat; + gfc_error ("%s attribute applied to %s %s at %L", a2, a1, + name, where); + return FAILURE; + } + + if (attr->is_bind_c) + { + gfc_error_now ("BIND(C) applied to %s %s at %L", a1, name, where); + return FAILURE; + } + break; case FL_VARIABLE: + break; + case FL_NAMELIST: + conf2 (result); break; case FL_PROCEDURE: ! /* Conflicts with INTENT will be checked at resolution stage, ! see "resolve_fl_procedure". */ if (attr->subroutine) { conf2 (target); conf2 (allocatable); conf2 (result); *************** check_conflict (symbol_attribute *attr, *** 616,625 **** conf2 (threadprivate); } switch (attr->proc) { case PROC_ST_FUNCTION: - conf2 (in_common); conf2 (dummy); break; --- 639,650 ---- conf2 (threadprivate); } + if (!attr->proc_pointer) + conf2 (in_common); + switch (attr->proc) { case PROC_ST_FUNCTION: conf2 (dummy); break; *************** check_conflict (symbol_attribute *attr, *** 629,635 **** case PROC_DUMMY: conf2 (result); - conf2 (in_common); conf2 (threadprivate); break; --- 654,659 ---- *************** check_conflict (symbol_attribute *attr, *** 651,656 **** --- 675,681 ---- conf2 (function); conf2 (subroutine); conf2 (threadprivate); + conf2 (result); if (attr->intent != INTENT_UNKNOWN) { *************** check_conflict (symbol_attribute *attr, *** 668,674 **** conf2 (subroutine); conf2 (entry); conf2 (pointer); ! conf2 (protected); conf2 (target); conf2 (dummy); conf2 (in_common); --- 693,699 ---- conf2 (subroutine); conf2 (entry); conf2 (pointer); ! conf2 (is_protected); conf2 (target); conf2 (dummy); conf2 (in_common); *************** check_conflict (symbol_attribute *attr, *** 677,682 **** --- 702,708 ---- conf2 (threadprivate); conf2 (value); conf2 (is_bind_c); + conf2 (result); break; default: *************** duplicate_attr (const char *attr, locus *** 774,780 **** /* Called from decl.c (attr_decl1) to check attributes, when declared separately. */ ! try gfc_add_attribute (symbol_attribute *attr, locus *where) { --- 800,806 ---- /* Called from decl.c (attr_decl1) to check attributes, when declared separately. */ ! gfc_try gfc_add_attribute (symbol_attribute *attr, locus *where) { *************** gfc_add_attribute (symbol_attribute *att *** 784,790 **** return check_conflict (attr, NULL, where); } ! try gfc_add_allocatable (symbol_attribute *attr, locus *where) { --- 810,816 ---- return check_conflict (attr, NULL, where); } ! gfc_try gfc_add_allocatable (symbol_attribute *attr, locus *where) { *************** gfc_add_allocatable (symbol_attribute *a *** 797,808 **** return FAILURE; } attr->allocatable = 1; return check_conflict (attr, NULL, where); } ! try gfc_add_dimension (symbol_attribute *attr, const char *name, locus *where) { --- 823,842 ---- return FAILURE; } + if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY + && gfc_find_state (COMP_INTERFACE) == FAILURE) + { + gfc_error ("ALLOCATABLE specified outside of INTERFACE body at %L", + where); + return FAILURE; + } + attr->allocatable = 1; return check_conflict (attr, NULL, where); } ! gfc_try gfc_add_dimension (symbol_attribute *attr, const char *name, locus *where) { *************** gfc_add_dimension (symbol_attribute *att *** 815,826 **** return FAILURE; } attr->dimension = 1; return check_conflict (attr, name, where); } ! try gfc_add_external (symbol_attribute *attr, locus *where) { --- 849,868 ---- return FAILURE; } + if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY + && gfc_find_state (COMP_INTERFACE) == FAILURE) + { + gfc_error ("DIMENSION specified for '%s' outside its INTERFACE body " + "at %L", name, where); + return FAILURE; + } + attr->dimension = 1; return check_conflict (attr, name, where); } ! gfc_try gfc_add_external (symbol_attribute *attr, locus *where) { *************** gfc_add_external (symbol_attribute *attr *** 833,845 **** return FAILURE; } attr->external = 1; return check_conflict (attr, NULL, where); } ! try gfc_add_intrinsic (symbol_attribute *attr, locus *where) { --- 875,893 ---- return FAILURE; } + if (attr->pointer && attr->if_source != IFSRC_IFBODY) + { + attr->pointer = 0; + attr->proc_pointer = 1; + } + attr->external = 1; return check_conflict (attr, NULL, where); } ! gfc_try gfc_add_intrinsic (symbol_attribute *attr, locus *where) { *************** gfc_add_intrinsic (symbol_attribute *att *** 858,864 **** } ! try gfc_add_optional (symbol_attribute *attr, locus *where) { --- 906,912 ---- } ! gfc_try gfc_add_optional (symbol_attribute *attr, locus *where) { *************** gfc_add_optional (symbol_attribute *attr *** 876,894 **** } ! try gfc_add_pointer (symbol_attribute *attr, locus *where) { if (check_used (attr, NULL, where)) return FAILURE; ! attr->pointer = 1; return check_conflict (attr, NULL, where); } ! try gfc_add_cray_pointer (symbol_attribute *attr, locus *where) { --- 924,955 ---- } ! gfc_try gfc_add_pointer (symbol_attribute *attr, locus *where) { if (check_used (attr, NULL, where)) return FAILURE; ! if (attr->pointer && !(attr->if_source == IFSRC_IFBODY ! && gfc_find_state (COMP_INTERFACE) == FAILURE)) ! { ! duplicate_attr ("POINTER", where); ! return FAILURE; ! } ! ! if (attr->procedure || (attr->external && attr->if_source != IFSRC_IFBODY) ! || (attr->if_source == IFSRC_IFBODY ! && gfc_find_state (COMP_INTERFACE) == FAILURE)) ! attr->proc_pointer = 1; ! else ! attr->pointer = 1; ! return check_conflict (attr, NULL, where); } ! gfc_try gfc_add_cray_pointer (symbol_attribute *attr, locus *where) { *************** gfc_add_cray_pointer (symbol_attribute * *** 900,906 **** } ! try gfc_add_cray_pointee (symbol_attribute *attr, locus *where) { --- 961,967 ---- } ! gfc_try gfc_add_cray_pointee (symbol_attribute *attr, locus *where) { *************** gfc_add_cray_pointee (symbol_attribute * *** 919,931 **** } ! try gfc_add_protected (symbol_attribute *attr, const char *name, locus *where) { if (check_used (attr, name, where)) return FAILURE; ! if (attr->protected) { if (gfc_notify_std (GFC_STD_LEGACY, "Duplicate PROTECTED attribute specified at %L", --- 980,992 ---- } ! gfc_try gfc_add_protected (symbol_attribute *attr, const char *name, locus *where) { if (check_used (attr, name, where)) return FAILURE; ! if (attr->is_protected) { if (gfc_notify_std (GFC_STD_LEGACY, "Duplicate PROTECTED attribute specified at %L", *************** gfc_add_protected (symbol_attribute *att *** 934,945 **** return FAILURE; } ! attr->protected = 1; return check_conflict (attr, name, where); } ! try gfc_add_result (symbol_attribute *attr, const char *name, locus *where) { --- 995,1006 ---- return FAILURE; } ! attr->is_protected = 1; return check_conflict (attr, name, where); } ! gfc_try gfc_add_result (symbol_attribute *attr, const char *name, locus *where) { *************** gfc_add_result (symbol_attribute *attr, *** 951,957 **** } ! try gfc_add_save (symbol_attribute *attr, const char *name, locus *where) { --- 1012,1018 ---- } ! gfc_try gfc_add_save (symbol_attribute *attr, const char *name, locus *where) { *************** gfc_add_save (symbol_attribute *attr, co *** 980,986 **** } ! try gfc_add_value (symbol_attribute *attr, const char *name, locus *where) { --- 1041,1047 ---- } ! gfc_try gfc_add_value (symbol_attribute *attr, const char *name, locus *where) { *************** gfc_add_value (symbol_attribute *attr, c *** 1001,1007 **** } ! try gfc_add_volatile (symbol_attribute *attr, const char *name, locus *where) { /* No check_used needed as 11.2.1 of the F2003 standard allows --- 1062,1068 ---- } ! gfc_try gfc_add_volatile (symbol_attribute *attr, const char *name, locus *where) { /* No check_used needed as 11.2.1 of the F2003 standard allows *************** gfc_add_volatile (symbol_attribute *attr *** 1020,1026 **** } ! try gfc_add_threadprivate (symbol_attribute *attr, const char *name, locus *where) { --- 1081,1087 ---- } ! gfc_try gfc_add_threadprivate (symbol_attribute *attr, const char *name, locus *where) { *************** gfc_add_threadprivate (symbol_attribute *** 1038,1044 **** } ! try gfc_add_target (symbol_attribute *attr, locus *where) { --- 1099,1105 ---- } ! gfc_try gfc_add_target (symbol_attribute *attr, locus *where) { *************** gfc_add_target (symbol_attribute *attr, *** 1056,1062 **** } ! try gfc_add_dummy (symbol_attribute *attr, const char *name, locus *where) { --- 1117,1123 ---- } ! gfc_try gfc_add_dummy (symbol_attribute *attr, const char *name, locus *where) { *************** gfc_add_dummy (symbol_attribute *attr, c *** 1069,1075 **** } ! try gfc_add_in_common (symbol_attribute *attr, const char *name, locus *where) { --- 1130,1136 ---- } ! gfc_try gfc_add_in_common (symbol_attribute *attr, const char *name, locus *where) { *************** gfc_add_in_common (symbol_attribute *att *** 1078,1094 **** /* Duplicate attribute already checked for. */ attr->in_common = 1; ! if (check_conflict (attr, name, where) == FAILURE) ! return FAILURE; ! ! if (attr->flavor == FL_VARIABLE) ! return SUCCESS; ! ! return gfc_add_flavor (attr, FL_VARIABLE, name, where); } ! try gfc_add_in_equivalence (symbol_attribute *attr, const char *name, locus *where) { --- 1139,1149 ---- /* Duplicate attribute already checked for. */ attr->in_common = 1; ! return check_conflict (attr, name, where); } ! gfc_try gfc_add_in_equivalence (symbol_attribute *attr, const char *name, locus *where) { *************** gfc_add_in_equivalence (symbol_attribute *** 1104,1110 **** } ! try gfc_add_data (symbol_attribute *attr, const char *name, locus *where) { --- 1159,1165 ---- } ! gfc_try gfc_add_data (symbol_attribute *attr, const char *name, locus *where) { *************** gfc_add_data (symbol_attribute *attr, co *** 1116,1122 **** } ! try gfc_add_in_namelist (symbol_attribute *attr, const char *name, locus *where) { --- 1171,1177 ---- } ! gfc_try gfc_add_in_namelist (symbol_attribute *attr, const char *name, locus *where) { *************** gfc_add_in_namelist (symbol_attribute *a *** 1125,1131 **** } ! try gfc_add_sequence (symbol_attribute *attr, const char *name, locus *where) { --- 1180,1186 ---- } ! gfc_try gfc_add_sequence (symbol_attribute *attr, const char *name, locus *where) { *************** gfc_add_sequence (symbol_attribute *attr *** 1137,1143 **** } ! try gfc_add_elemental (symbol_attribute *attr, locus *where) { --- 1192,1198 ---- } ! gfc_try gfc_add_elemental (symbol_attribute *attr, locus *where) { *************** gfc_add_elemental (symbol_attribute *att *** 1155,1161 **** } ! try gfc_add_pure (symbol_attribute *attr, locus *where) { --- 1210,1216 ---- } ! gfc_try gfc_add_pure (symbol_attribute *attr, locus *where) { *************** gfc_add_pure (symbol_attribute *attr, lo *** 1173,1179 **** } ! try gfc_add_recursive (symbol_attribute *attr, locus *where) { --- 1228,1234 ---- } ! gfc_try gfc_add_recursive (symbol_attribute *attr, locus *where) { *************** gfc_add_recursive (symbol_attribute *att *** 1191,1197 **** } ! try gfc_add_entry (symbol_attribute *attr, const char *name, locus *where) { --- 1246,1252 ---- } ! gfc_try gfc_add_entry (symbol_attribute *attr, const char *name, locus *where) { *************** gfc_add_entry (symbol_attribute *attr, c *** 1209,1215 **** } ! try gfc_add_function (symbol_attribute *attr, const char *name, locus *where) { --- 1264,1270 ---- } ! gfc_try gfc_add_function (symbol_attribute *attr, const char *name, locus *where) { *************** gfc_add_function (symbol_attribute *attr *** 1222,1228 **** } ! try gfc_add_subroutine (symbol_attribute *attr, const char *name, locus *where) { --- 1277,1283 ---- } ! gfc_try gfc_add_subroutine (symbol_attribute *attr, const char *name, locus *where) { *************** gfc_add_subroutine (symbol_attribute *at *** 1235,1241 **** } ! try gfc_add_generic (symbol_attribute *attr, const char *name, locus *where) { --- 1290,1296 ---- } ! gfc_try gfc_add_generic (symbol_attribute *attr, const char *name, locus *where) { *************** gfc_add_generic (symbol_attribute *attr, *** 1248,1254 **** } ! try gfc_add_proc (symbol_attribute *attr, const char *name, locus *where) { --- 1303,1309 ---- } ! gfc_try gfc_add_proc (symbol_attribute *attr, const char *name, locus *where) { *************** gfc_add_proc (symbol_attribute *attr, co *** 1271,1280 **** } /* Flavors are special because some flavors are not what Fortran considers attributes and can be reaffirmed multiple times. */ ! try gfc_add_flavor (symbol_attribute *attr, sym_flavor f, const char *name, locus *where) { --- 1326,1349 ---- } + gfc_try + gfc_add_abstract (symbol_attribute* attr, locus* where) + { + if (attr->abstract) + { + duplicate_attr ("ABSTRACT", where); + return FAILURE; + } + + attr->abstract = 1; + return SUCCESS; + } + + /* Flavors are special because some flavors are not what Fortran considers attributes and can be reaffirmed multiple times. */ ! gfc_try gfc_add_flavor (symbol_attribute *attr, sym_flavor f, const char *name, locus *where) { *************** gfc_add_flavor (symbol_attribute *attr, *** 1310,1316 **** } ! try gfc_add_procedure (symbol_attribute *attr, procedure_type t, const char *name, locus *where) { --- 1379,1385 ---- } ! gfc_try gfc_add_procedure (symbol_attribute *attr, procedure_type t, const char *name, locus *where) { *************** gfc_add_procedure (symbol_attribute *att *** 1346,1352 **** } ! try gfc_add_intent (symbol_attribute *attr, sym_intent intent, locus *where) { --- 1415,1421 ---- } ! gfc_try gfc_add_intent (symbol_attribute *attr, sym_intent intent, locus *where) { *************** gfc_add_intent (symbol_attribute *attr, *** 1372,1378 **** /* No checks for use-association in public and private statements. */ ! try gfc_add_access (symbol_attribute *attr, gfc_access access, const char *name, locus *where) { --- 1441,1447 ---- /* No checks for use-association in public and private statements. */ ! gfc_try gfc_add_access (symbol_attribute *attr, gfc_access access, const char *name, locus *where) { *************** gfc_add_access (symbol_attribute *attr, *** 1394,1400 **** /* Set the is_bind_c field for the given symbol_attribute. */ ! try gfc_add_is_bind_c (symbol_attribute *attr, const char *name, locus *where, int is_proc_lang_bind_spec) { --- 1463,1469 ---- /* Set the is_bind_c field for the given symbol_attribute. */ ! gfc_try gfc_add_is_bind_c (symbol_attribute *attr, const char *name, locus *where, int is_proc_lang_bind_spec) { *************** gfc_add_is_bind_c (symbol_attribute *att *** 1418,1424 **** } ! try gfc_add_explicit_interface (gfc_symbol *sym, ifsrc source, gfc_formal_arglist * formal, locus *where) { --- 1487,1514 ---- } ! /* Set the extension field for the given symbol_attribute. */ ! ! gfc_try ! gfc_add_extension (symbol_attribute *attr, locus *where) ! { ! if (where == NULL) ! where = &gfc_current_locus; ! ! if (attr->extension) ! gfc_error_now ("Duplicate EXTENDS attribute specified at %L", where); ! else ! attr->extension = 1; ! ! if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: EXTENDS at %L", where) ! == FAILURE) ! return FAILURE; ! ! return SUCCESS; ! } ! ! ! gfc_try gfc_add_explicit_interface (gfc_symbol *sym, ifsrc source, gfc_formal_arglist * formal, locus *where) { *************** gfc_add_explicit_interface (gfc_symbol * *** 1437,1442 **** --- 1527,1539 ---- return FAILURE; } + if (source == IFSRC_IFBODY && (sym->attr.dimension || sym->attr.allocatable)) + { + gfc_error ("'%s' at %L has attributes specified outside its INTERFACE " + "body", sym->name, where); + return FAILURE; + } + sym->formal = formal; sym->attr.if_source = source; *************** gfc_add_explicit_interface (gfc_symbol * *** 1446,1452 **** /* Add a type to a symbol. */ ! try gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where) { sym_flavor flavor; --- 1543,1549 ---- /* Add a type to a symbol. */ ! gfc_try gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where) { sym_flavor flavor; *************** gfc_add_type (gfc_symbol *sym, gfc_types *** 1465,1473 **** gfc_error (msg, sym->name, where, gfc_basic_typename (sym->ts.type)); return FAILURE; } ! else if (gfc_notify_std (GFC_STD_GNU, msg, sym->name, where, ! gfc_basic_typename (sym->ts.type)) == FAILURE) return FAILURE; } flavor = sym->attr.flavor; --- 1562,1572 ---- gfc_error (msg, sym->name, where, gfc_basic_typename (sym->ts.type)); return FAILURE; } ! if (gfc_notify_std (GFC_STD_GNU, msg, sym->name, where, ! gfc_basic_typename (sym->ts.type)) == FAILURE) return FAILURE; + if (gfc_option.warn_surprising) + gfc_warning (msg, sym->name, where, gfc_basic_typename (sym->ts.type)); } flavor = sym->attr.flavor; *************** gfc_clear_attr (symbol_attribute *attr) *** 1498,1504 **** /* Check for missing attributes in the new symbol. Currently does nothing, but it's not clear that it is unnecessary yet. */ ! try gfc_missing_attr (symbol_attribute *attr ATTRIBUTE_UNUSED, locus *where ATTRIBUTE_UNUSED) { --- 1597,1603 ---- /* Check for missing attributes in the new symbol. Currently does nothing, but it's not clear that it is unnecessary yet. */ ! gfc_try gfc_missing_attr (symbol_attribute *attr ATTRIBUTE_UNUSED, locus *where ATTRIBUTE_UNUSED) { *************** gfc_missing_attr (symbol_attribute *attr *** 1511,1517 **** attributes have a lot of side-effects but cannot be present given where we are called from, so we ignore some bits. */ ! try gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where) { int is_proc_lang_bind_spec; --- 1610,1616 ---- attributes have a lot of side-effects but cannot be present given where we are called from, so we ignore some bits. */ ! gfc_try gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where) { int is_proc_lang_bind_spec; *************** gfc_copy_attr (symbol_attribute *dest, s *** 1525,1531 **** goto fail; if (src->pointer && gfc_add_pointer (dest, where) == FAILURE) goto fail; ! if (src->protected && gfc_add_protected (dest, NULL, where) == FAILURE) goto fail; if (src->save && gfc_add_save (dest, NULL, where) == FAILURE) goto fail; --- 1624,1630 ---- goto fail; if (src->pointer && gfc_add_pointer (dest, where) == FAILURE) goto fail; ! if (src->is_protected && gfc_add_protected (dest, NULL, where) == FAILURE) goto fail; if (src->save && gfc_add_save (dest, NULL, where) == FAILURE) goto fail; *************** gfc_copy_attr (symbol_attribute *dest, s *** 1602,1607 **** --- 1701,1708 ---- goto fail; if (src->intrinsic && gfc_add_intrinsic (dest, where) == FAILURE) goto fail; + if (src->proc_pointer) + dest->proc_pointer = 1; return SUCCESS; *************** fail: *** 1622,1628 **** already present. On success, the component pointer is modified to point to the additional component structure. */ ! try gfc_add_component (gfc_symbol *sym, const char *name, gfc_component **component) { --- 1723,1729 ---- already present. On success, the component pointer is modified to point to the additional component structure. */ ! gfc_try gfc_add_component (gfc_symbol *sym, const char *name, gfc_component **component) { *************** gfc_add_component (gfc_symbol *sym, cons *** 1642,1647 **** --- 1743,1756 ---- tail = p; } + if (sym->attr.extension + && gfc_find_component (sym->components->ts.derived, name, true, true)) + { + gfc_error ("Component '%s' at %C already in the parent type " + "at %L", name, &sym->components->ts.derived->declared_at); + return FAILURE; + } + /* Allocate a new component. */ p = gfc_get_component (); *************** bad: *** 1752,1761 **** /* Given a derived type node and a component name, try to locate the component structure. Returns the NULL pointer if the component is ! not found or the components are private. */ gfc_component * ! gfc_find_component (gfc_symbol *sym, const char *name) { gfc_component *p; --- 1861,1872 ---- /* Given a derived type node and a component name, try to locate the component structure. Returns the NULL pointer if the component is ! not found or the components are private. If noaccess is set, no access ! checks are done. */ gfc_component * ! gfc_find_component (gfc_symbol *sym, const char *name, ! bool noaccess, bool silent) { gfc_component *p; *************** gfc_find_component (gfc_symbol *sym, con *** 1771,1787 **** if (strcmp (p->name, name) == 0) break; ! if (p == NULL) gfc_error ("'%s' at %C is not a member of the '%s' structure", name, sym->name); ! else { ! if (sym->attr.use_assoc && (sym->component_access == ACCESS_PRIVATE ! || p->access == ACCESS_PRIVATE)) { ! gfc_error ("Component '%s' at %C is a PRIVATE component of '%s'", ! name, sym->name); ! p = NULL; } } --- 1882,1920 ---- if (strcmp (p->name, name) == 0) break; ! if (p == NULL ! && sym->attr.extension ! && sym->components->ts.type == BT_DERIVED) ! { ! p = gfc_find_component (sym->components->ts.derived, name, ! noaccess, silent); ! /* Do not overwrite the error. */ ! if (p == NULL) ! return p; ! } ! ! if (p == NULL && !silent) gfc_error ("'%s' at %C is not a member of the '%s' structure", name, sym->name); ! ! else if (sym->attr.use_assoc && !noaccess) { ! if (p->attr.access == ACCESS_PRIVATE) { ! if (!silent) ! gfc_error ("Component '%s' at %C is a PRIVATE component of '%s'", ! name, sym->name); ! return NULL; ! } ! ! /* If there were components given and all components are private, error ! out at this place. */ ! if (p->attr.access != ACCESS_PUBLIC && sym->component_access == ACCESS_PRIVATE) ! { ! if (!silent) ! gfc_error ("All components of '%s' are PRIVATE in structure" ! " constructor at %C", sym->name); ! return NULL; } } *************** free_components (gfc_component *p) *** 1809,1842 **** } - /* Set component attributes from a standard symbol attribute structure. */ - - void - gfc_set_component_attr (gfc_component *c, symbol_attribute *attr) - { - - c->dimension = attr->dimension; - c->pointer = attr->pointer; - c->allocatable = attr->allocatable; - c->access = attr->access; - } - - - /* Get a standard symbol attribute structure given the component - structure. */ - - void - gfc_get_component_attr (symbol_attribute *attr, gfc_component *c) - { - - gfc_clear_attr (attr); - attr->dimension = c->dimension; - attr->pointer = c->pointer; - attr->allocatable = c->allocatable; - attr->access = c->access; - } - - /******************** Statement label management ********************/ /* Comparison function for statement labels, used for managing the --- 1942,1947 ---- *************** gfc_get_st_label (int labelno) *** 1911,1917 **** lp = lp->right; } ! lp = gfc_getmem (sizeof (gfc_st_label)); lp->value = labelno; lp->defined = ST_LABEL_UNKNOWN; --- 2016,2022 ---- lp = lp->right; } ! lp = XCNEW (gfc_st_label); lp->value = labelno; lp->defined = ST_LABEL_UNKNOWN; *************** gfc_define_st_label (gfc_st_label *lp, g *** 1975,1986 **** updating the unknown state. Returns FAILURE if something goes wrong. */ ! try gfc_reference_st_label (gfc_st_label *lp, gfc_sl_type type) { gfc_sl_type label_type; int labelno; ! try rc; if (lp == NULL) return SUCCESS; --- 2080,2091 ---- updating the unknown state. Returns FAILURE if something goes wrong. */ ! gfc_try gfc_reference_st_label (gfc_st_label *lp, gfc_sl_type type) { gfc_sl_type label_type; int labelno; ! gfc_try rc; if (lp == NULL) return SUCCESS; *************** gfc_get_namespace (gfc_namespace *parent *** 2077,2085 **** gfc_intrinsic_op in; int i; ! ns = gfc_getmem (sizeof (gfc_namespace)); ns->sym_root = NULL; ns->uop_root = NULL; ns->default_access = ACCESS_UNKNOWN; ns->parent = parent; --- 2182,2191 ---- gfc_intrinsic_op in; int i; ! ns = XCNEW (gfc_namespace); ns->sym_root = NULL; ns->uop_root = NULL; + ns->finalizers = NULL; ns->default_access = ACCESS_UNKNOWN; ns->parent = parent; *************** gfc_new_symtree (gfc_symtree **root, con *** 2144,2151 **** { gfc_symtree *st; ! st = gfc_getmem (sizeof (gfc_symtree)); st->name = gfc_get_string (name); gfc_insert_bbt (root, st, compare_symtree); return st; --- 2250,2258 ---- { gfc_symtree *st; ! st = XCNEW (gfc_symtree); st->name = gfc_get_string (name); + st->typebound = NULL; gfc_insert_bbt (root, st, compare_symtree); return st; *************** gfc_get_uop (const char *name) *** 2219,2225 **** st = gfc_new_symtree (&gfc_current_ns->uop_root, name); ! uop = st->n.uop = gfc_getmem (sizeof (gfc_user_op)); uop->name = gfc_get_string (name); uop->access = ACCESS_UNKNOWN; uop->ns = gfc_current_ns; --- 2326,2332 ---- st = gfc_new_symtree (&gfc_current_ns->uop_root, name); ! uop = st->n.uop = XCNEW (gfc_user_op); uop->name = gfc_get_string (name); uop->access = ACCESS_UNKNOWN; uop->ns = gfc_current_ns; *************** gfc_free_symbol (gfc_symbol *sym) *** 2268,2273 **** --- 2375,2382 ---- gfc_free_formal_arglist (sym->formal); + gfc_free_namespace (sym->f2k_derived); + gfc_free (sym); } *************** gfc_new_symbol (const char *name, gfc_na *** 2279,2285 **** { gfc_symbol *p; ! p = gfc_getmem (sizeof (gfc_symbol)); gfc_clear_ts (&p->ts); gfc_clear_attr (&p->attr); --- 2388,2394 ---- { gfc_symbol *p; ! p = XCNEW (gfc_symbol); gfc_clear_ts (&p->ts); gfc_clear_attr (&p->attr); *************** gfc_new_symbol (const char *name, gfc_na *** 2300,2305 **** --- 2409,2415 ---- /* Clear the ptrs we may need. */ p->common_block = NULL; + p->f2k_derived = NULL; return p; } *************** static void *** 2388,2397 **** save_symbol_data (gfc_symbol *sym) { ! if (sym->new || sym->old_symbol != NULL) return; ! sym->old_symbol = gfc_getmem (sizeof (gfc_symbol)); *(sym->old_symbol) = *sym; sym->tlink = changed_syms; --- 2498,2507 ---- save_symbol_data (gfc_symbol *sym) { ! if (sym->gfc_new || sym->old_symbol != NULL) return; ! sym->old_symbol = XCNEW (gfc_symbol); *(sym->old_symbol) = *sym; sym->tlink = changed_syms; *************** gfc_get_sym_tree (const char *name, gfc_ *** 2432,2438 **** p->old_symbol = NULL; p->tlink = changed_syms; p->mark = 1; ! p->new = 1; changed_syms = p; st = gfc_new_symtree (&ns->sym_root, name); --- 2542,2548 ---- p->old_symbol = NULL; p->tlink = changed_syms; p->mark = 1; ! p->gfc_new = 1; changed_syms = p; st = gfc_new_symtree (&ns->sym_root, name); *************** gfc_undo_symbols (void) *** 2580,2586 **** { q = p->tlink; ! if (p->new) { /* Symbol was new. */ if (p->attr.in_common && p->common_block->head) --- 2690,2696 ---- { q = p->tlink; ! if (p->gfc_new) { /* Symbol was new. */ if (p->attr.in_common && p->common_block->head) *************** gfc_commit_symbols (void) *** 2716,2722 **** q = p->tlink; p->tlink = NULL; p->mark = 0; ! p->new = 0; free_old_symbol (p); } changed_syms = NULL; --- 2826,2832 ---- q = p->tlink; p->tlink = NULL; p->mark = 0; ! p->gfc_new = 0; free_old_symbol (p); } changed_syms = NULL; *************** gfc_commit_symbol (gfc_symbol *sym) *** 2745,2751 **** sym->tlink = NULL; sym->mark = 0; ! sym->new = 0; free_old_symbol (sym); } --- 2855,2861 ---- sym->tlink = NULL; sym->mark = 0; ! sym->gfc_new = 0; free_old_symbol (sym); } *************** free_uop_tree (gfc_symtree *uop_tree) *** 2780,2786 **** free_uop_tree (uop_tree->left); free_uop_tree (uop_tree->right); ! gfc_free_interface (uop_tree->n.uop->operator); gfc_free (uop_tree->n.uop); gfc_free (uop_tree); --- 2890,2896 ---- free_uop_tree (uop_tree->left); free_uop_tree (uop_tree->right); ! gfc_free_interface (uop_tree->n.uop->op); gfc_free (uop_tree->n.uop); gfc_free (uop_tree); *************** gfc_free_equiv_lists (gfc_equiv_list *l) *** 2868,2873 **** --- 2978,3031 ---- } + /* Free a finalizer procedure list. */ + + void + gfc_free_finalizer (gfc_finalizer* el) + { + if (el) + { + if (el->proc_sym) + { + --el->proc_sym->refs; + if (!el->proc_sym->refs) + gfc_free_symbol (el->proc_sym); + } + + gfc_free (el); + } + } + + static void + gfc_free_finalizer_list (gfc_finalizer* list) + { + while (list) + { + gfc_finalizer* current = list; + list = list->next; + gfc_free_finalizer (current); + } + } + + + /* Free the charlen list from cl to end (end is not freed). + Free the whole list if end is NULL. */ + + void gfc_free_charlen (gfc_charlen *cl, gfc_charlen *end) + { + gfc_charlen *cl2; + + for (; cl != end; cl = cl2) + { + gcc_assert (cl); + + cl2 = cl->next; + gfc_free_expr (cl->length); + gfc_free (cl); + } + } + + /* Free a namespace structure and everything below it. Interface lists associated with intrinsic operators are not freed. These are taken care of when a specific name is freed. */ *************** gfc_free_equiv_lists (gfc_equiv_list *l) *** 2875,2881 **** void gfc_free_namespace (gfc_namespace *ns) { - gfc_charlen *cl, *cl2; gfc_namespace *p, *q; gfc_intrinsic_op i; --- 3033,3038 ---- *************** gfc_free_namespace (gfc_namespace *ns) *** 2892,2912 **** free_sym_tree (ns->sym_root); free_uop_tree (ns->uop_root); free_common_tree (ns->common_root); ! ! for (cl = ns->cl_list; cl; cl = cl2) ! { ! cl2 = cl->next; ! gfc_free_expr (cl->length); ! gfc_free (cl); ! } ! free_st_labels (ns->st_labels); gfc_free_equiv (ns->equiv); gfc_free_equiv_lists (ns->equiv_lists); for (i = GFC_INTRINSIC_BEGIN; i != GFC_INTRINSIC_END; i++) ! gfc_free_interface (ns->operator[i]); gfc_free_data (ns->data); p = ns->contained; --- 3049,3064 ---- free_sym_tree (ns->sym_root); free_uop_tree (ns->uop_root); free_common_tree (ns->common_root); ! gfc_free_finalizer_list (ns->finalizers); ! gfc_free_charlen (ns->cl_list, NULL); free_st_labels (ns->st_labels); gfc_free_equiv (ns->equiv); gfc_free_equiv_lists (ns->equiv_lists); + gfc_free_use_stmts (ns->use_stmts); for (i = GFC_INTRINSIC_BEGIN; i != GFC_INTRINSIC_END; i++) ! gfc_free_interface (ns->op[i]); gfc_free_data (ns->data); p = ns->contained; *************** save_symbol (gfc_symbol *sym) *** 3045,3050 **** --- 3197,3203 ---- if (sym->attr.in_common || sym->attr.dummy + || sym->attr.result || sym->attr.flavor != FL_VARIABLE) return; /* Automatic objects are not saved. */ *************** gfc_get_gsymbol (const char *name) *** 3125,3131 **** if (s != NULL) return s; ! s = gfc_getmem (sizeof (gfc_gsymbol)); s->type = GSYM_UNKNOWN; s->name = gfc_get_string (name); --- 3278,3284 ---- if (s != NULL) return s; ! s = XCNEW (gfc_gsymbol); s->type = GSYM_UNKNOWN; s->name = gfc_get_string (name); *************** get_iso_c_binding_dt (int sym_id) *** 3165,3176 **** for such. If an error occurs, the errors are reported here, allowing for multiple errors to be handled for a single derived type. */ ! try verify_bind_c_derived_type (gfc_symbol *derived_sym) { gfc_component *curr_comp = NULL; ! try is_c_interop = FAILURE; ! try retval = SUCCESS; if (derived_sym == NULL) gfc_internal_error ("verify_bind_c_derived_type(): Given symbol is " --- 3318,3329 ---- for such. If an error occurs, the errors are reported here, allowing for multiple errors to be handled for a single derived type. */ ! gfc_try verify_bind_c_derived_type (gfc_symbol *derived_sym) { gfc_component *curr_comp = NULL; ! gfc_try is_c_interop = FAILURE; ! gfc_try retval = SUCCESS; if (derived_sym == NULL) gfc_internal_error ("verify_bind_c_derived_type(): Given symbol is " *************** verify_bind_c_derived_type (gfc_symbol * *** 3212,3218 **** { /* The components cannot be pointers (fortran sense). J3/04-007, Section 15.2.3, C1505. */ ! if (curr_comp->pointer != 0) { gfc_error ("Component '%s' at %L cannot have the " "POINTER attribute because it is a member " --- 3365,3371 ---- { /* The components cannot be pointers (fortran sense). J3/04-007, Section 15.2.3, C1505. */ ! if (curr_comp->attr.pointer != 0) { gfc_error ("Component '%s' at %L cannot have the " "POINTER attribute because it is a member " *************** verify_bind_c_derived_type (gfc_symbol * *** 3224,3230 **** /* The components cannot be allocatable. J3/04-007, Section 15.2.3, C1505. */ ! if (curr_comp->allocatable != 0) { gfc_error ("Component '%s' at %L cannot have the " "ALLOCATABLE attribute because it is a member " --- 3377,3383 ---- /* The components cannot be allocatable. J3/04-007, Section 15.2.3, C1505. */ ! if (curr_comp->attr.allocatable != 0) { gfc_error ("Component '%s' at %L cannot have the " "ALLOCATABLE attribute because it is a member " *************** verify_bind_c_derived_type (gfc_symbol * *** 3248,3255 **** else { /* Grab the typespec for the given component and test the kind. */ ! is_c_interop = verify_c_interop (&(curr_comp->ts), curr_comp->name, ! &(curr_comp->loc)); if (is_c_interop != SUCCESS) { --- 3401,3407 ---- else { /* Grab the typespec for the given component and test the kind. */ ! is_c_interop = verify_c_interop (&(curr_comp->ts)); if (is_c_interop != SUCCESS) { *************** verify_bind_c_derived_type (gfc_symbol * *** 3314,3320 **** /* Generate symbols for the named constants c_null_ptr and c_null_funptr. */ ! static try gen_special_c_interop_ptr (int ptr_id, const char *ptr_name, const char *module_name) { --- 3466,3472 ---- /* Generate symbols for the named constants c_null_ptr and c_null_funptr. */ ! static gfc_try gen_special_c_interop_ptr (int ptr_id, const char *ptr_name, const char *module_name) { *************** static void *** 3502,3508 **** gen_fptr_param (gfc_formal_arglist **head, gfc_formal_arglist **tail, const char *module_name, ! gfc_namespace *ns, const char *f_ptr_name) { gfc_symbol *param_sym = NULL; gfc_symtree *param_symtree = NULL; --- 3654,3660 ---- gen_fptr_param (gfc_formal_arglist **head, gfc_formal_arglist **tail, const char *module_name, ! gfc_namespace *ns, const char *f_ptr_name, int proc) { gfc_symbol *param_sym = NULL; gfc_symtree *param_symtree = NULL; *************** gen_fptr_param (gfc_formal_arglist **hea *** 3521,3527 **** /* Set up the necessary fields for the fptr output param sym. */ param_sym->refs++; ! param_sym->attr.pointer = 1; param_sym->attr.dummy = 1; param_sym->attr.use_assoc = 1; --- 3673,3682 ---- /* Set up the necessary fields for the fptr output param sym. */ param_sym->refs++; ! if (proc) ! param_sym->attr.proc_pointer = 1; ! else ! param_sym->attr.pointer = 1; param_sym->attr.dummy = 1; param_sym->attr.use_assoc = 1; *************** add_proc_interface (gfc_symbol *sym, ifs *** 3625,3631 **** declaration statement (see match_proc_decl()) to create the formal args based on the args of a given named interface. */ ! void copy_formal_args (gfc_symbol *dest, gfc_symbol *src) { gfc_formal_arglist *head = NULL; gfc_formal_arglist *tail = NULL; --- 3780,3787 ---- declaration statement (see match_proc_decl()) to create the formal args based on the args of a given named interface. */ ! void ! copy_formal_args (gfc_symbol *dest, gfc_symbol *src) { gfc_formal_arglist *head = NULL; gfc_formal_arglist *tail = NULL; *************** void copy_formal_args (gfc_symbol *dest, *** 3648,3653 **** --- 3804,3811 ---- /* May need to copy more info for the symbol. */ formal_arg->sym->attr = curr_arg->sym->attr; formal_arg->sym->ts = curr_arg->sym->ts; + formal_arg->sym->as = gfc_copy_array_spec (curr_arg->sym->as); + copy_formal_args (formal_arg->sym, curr_arg->sym); /* If this isn't the first arg, set up the next ptr. For the last arg built, the formal_arg->next will never get set to *************** build_formal_args (gfc_symbol *new_proc_ *** 3699,3719 **** gfc_current_ns->proc_name = new_proc_sym; /* Generate the params. */ ! if ((old_sym->intmod_sym_id == ISOCBINDING_F_POINTER) || ! (old_sym->intmod_sym_id == ISOCBINDING_F_PROCPOINTER)) { gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module, gfc_current_ns, "cptr", old_sym->intmod_sym_id); gen_fptr_param (&head, &tail, (const char *) new_proc_sym->module, ! gfc_current_ns, "fptr"); ! /* If we're dealing with c_f_pointer, it has an optional third arg. */ ! if (old_sym->intmod_sym_id == ISOCBINDING_F_POINTER) ! { ! gen_shape_param (&head, &tail, ! (const char *) new_proc_sym->module, ! gfc_current_ns, "shape"); ! } } else if (old_sym->intmod_sym_id == ISOCBINDING_ASSOCIATED) { --- 3857,3879 ---- gfc_current_ns->proc_name = new_proc_sym; /* Generate the params. */ ! if (old_sym->intmod_sym_id == ISOCBINDING_F_PROCPOINTER) { gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module, gfc_current_ns, "cptr", old_sym->intmod_sym_id); gen_fptr_param (&head, &tail, (const char *) new_proc_sym->module, ! gfc_current_ns, "fptr", 1); ! } ! else if (old_sym->intmod_sym_id == ISOCBINDING_F_POINTER) ! { ! gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module, ! gfc_current_ns, "cptr", old_sym->intmod_sym_id); ! gen_fptr_param (&head, &tail, (const char *) new_proc_sym->module, ! gfc_current_ns, "fptr", 0); /* If we're dealing with c_f_pointer, it has an optional third arg. */ ! gen_shape_param (&head, &tail,(const char *) new_proc_sym->module, ! gfc_current_ns, "shape"); ! } else if (old_sym->intmod_sym_id == ISOCBINDING_ASSOCIATED) { *************** build_formal_args (gfc_symbol *new_proc_ *** 3740,3745 **** --- 3900,3919 ---- gfc_current_ns = parent_ns; } + static int + std_for_isocbinding_symbol (int id) + { + switch (id) + { + #define NAMED_INTCST(a,b,c,d) \ + case a:\ + return d; + #include "iso-c-binding.def" + #undef NAMED_INTCST + default: + return GFC_STD_F2003; + } + } /* Generate the given set of C interoperable kind objects, or all interoperable kinds. This function will only be given kind objects *************** generate_isocbinding_symbol (const char *** 3765,3770 **** --- 3939,3946 ---- char comp_name[(GFC_MAX_SYMBOL_LEN * 2) + 1]; int index; + if (gfc_notification_std (std_for_isocbinding_symbol (s)) == ERROR) + return; tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name); /* Already exists in this scope so don't re-add it. *************** generate_isocbinding_symbol (const char *** 3788,3794 **** switch (s) { ! #define NAMED_INTCST(a,b,c) case a : #define NAMED_REALCST(a,b,c) case a : #define NAMED_CMPXCST(a,b,c) case a : #define NAMED_LOGCST(a,b,c) case a : --- 3964,3970 ---- switch (s) { ! #define NAMED_INTCST(a,b,c,d) case a : #define NAMED_REALCST(a,b,c) case a : #define NAMED_CMPXCST(a,b,c) case a : #define NAMED_LOGCST(a,b,c) case a : *************** generate_isocbinding_symbol (const char *** 3833,3841 **** tmp_sym->value->ts.is_c_interop = 1; tmp_sym->value->ts.is_iso_c = 1; tmp_sym->value->value.character.length = 1; ! tmp_sym->value->value.character.string = gfc_getmem (2); tmp_sym->value->value.character.string[0] ! = (char) c_interop_kinds_table[s].value; tmp_sym->value->value.character.string[1] = '\0'; tmp_sym->ts.cl = gfc_get_charlen (); tmp_sym->ts.cl->length = gfc_int_expr (1); --- 4009,4017 ---- tmp_sym->value->ts.is_c_interop = 1; tmp_sym->value->ts.is_iso_c = 1; tmp_sym->value->value.character.length = 1; ! tmp_sym->value->value.character.string = gfc_get_wide_string (2); tmp_sym->value->value.character.string[0] ! = (gfc_char_t) c_interop_kinds_table[s].value; tmp_sym->value->value.character.string[1] = '\0'; tmp_sym->ts.cl = gfc_get_charlen (); tmp_sym->ts.cl->length = gfc_int_expr (1); *************** generate_isocbinding_symbol (const char *** 3916,3923 **** index = get_c_kind ("c_ptr", c_interop_kinds_table); tmp_comp->ts.kind = c_interop_kinds_table[index].value; ! tmp_comp->pointer = 0; ! tmp_comp->dimension = 0; /* Mark the component as C interoperable. */ tmp_comp->ts.is_c_interop = 1; --- 4092,4099 ---- index = get_c_kind ("c_ptr", c_interop_kinds_table); tmp_comp->ts.kind = c_interop_kinds_table[index].value; ! tmp_comp->attr.pointer = 0; ! tmp_comp->attr.dimension = 0; /* Mark the component as C interoperable. */ tmp_comp->ts.is_c_interop = 1; *************** generate_isocbinding_symbol (const char *** 3993,3998 **** --- 4169,4175 ---- tmp_sym->result = tmp_sym; tmp_sym->attr.external = 1; tmp_sym->attr.use_assoc = 0; + tmp_sym->attr.pure = 1; tmp_sym->attr.if_source = IFSRC_UNKNOWN; tmp_sym->attr.proc = PROC_UNKNOWN; } *************** get_iso_c_sym (gfc_symbol *old_sym, char *** 4068,4070 **** --- 4245,4343 ---- return new_symtree->n.sym; } + + /* Check that a symbol is already typed. If strict is not set, an untyped + symbol is acceptable for non-standard-conforming mode. */ + + gfc_try + gfc_check_symbol_typed (gfc_symbol* sym, gfc_namespace* ns, + bool strict, locus where) + { + gcc_assert (sym); + + if (gfc_matching_prefix) + return SUCCESS; + + /* Check for the type and try to give it an implicit one. */ + if (sym->ts.type == BT_UNKNOWN + && gfc_set_default_type (sym, 0, ns) == FAILURE) + { + if (strict) + { + gfc_error ("Symbol '%s' is used before it is typed at %L", + sym->name, &where); + return FAILURE; + } + + if (gfc_notify_std (GFC_STD_GNU, + "Extension: Symbol '%s' is used before" + " it is typed at %L", sym->name, &where) == FAILURE) + return FAILURE; + } + + /* Everything is ok. */ + return SUCCESS; + } + + + /* Get the super-type of a given derived type. */ + + gfc_symbol* + gfc_get_derived_super_type (gfc_symbol* derived) + { + if (!derived->attr.extension) + return NULL; + + gcc_assert (derived->components); + gcc_assert (derived->components->ts.type == BT_DERIVED); + gcc_assert (derived->components->ts.derived); + + return derived->components->ts.derived; + } + + + /* Find a type-bound procedure by name for a derived-type (looking recursively + through the super-types). */ + + gfc_symtree* + gfc_find_typebound_proc (gfc_symbol* derived, gfc_try* t, + const char* name, bool noaccess) + { + gfc_symtree* res; + + /* Set default to failure. */ + if (t) + *t = FAILURE; + + /* Try to find it in the current type's namespace. */ + gcc_assert (derived->f2k_derived); + res = gfc_find_symtree (derived->f2k_derived->sym_root, name); + if (res && res->typebound) + { + /* We found one. */ + if (t) + *t = SUCCESS; + + if (!noaccess && derived->attr.use_assoc + && res->typebound->access == ACCESS_PRIVATE) + { + gfc_error ("'%s' of '%s' is PRIVATE at %C", name, derived->name); + if (t) + *t = FAILURE; + } + + return res; + } + + /* Otherwise, recurse on parent type if derived is an extension. */ + if (derived->attr.extension) + { + gfc_symbol* super_type; + super_type = gfc_get_derived_super_type (derived); + gcc_assert (super_type); + return gfc_find_typebound_proc (super_type, t, name, noaccess); + } + + /* Nothing found. */ + return NULL; + } diff -Nrcpad gcc-4.3.3/gcc/fortran/target-memory.c gcc-4.4.0/gcc/fortran/target-memory.c *** gcc-4.3.3/gcc/fortran/target-memory.c Sun Jan 11 13:42:32 2009 --- gcc-4.4.0/gcc/fortran/target-memory.c Sat Jan 10 00:15:37 2009 *************** *** 1,5 **** /* Simulate storage of variables into target memory. ! Copyright (C) 2007 Free Software Foundation, Inc. Contributed by Paul Thomas and Brooks Moses --- 1,5 ---- /* Simulate storage of variables into target memory. ! Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Paul Thomas and Brooks Moses *************** size_logical (int kind) *** 73,81 **** static size_t ! size_character (int length) { ! return length; } --- 73,82 ---- static size_t ! size_character (int length, int kind) { ! int i = gfc_validate_kind (BT_CHARACTER, kind, false); ! return length * gfc_character_kinds[i].bit_size / 8; } *************** gfc_target_expr_size (gfc_expr *e) *** 101,115 **** return size_logical (e->ts.kind); case BT_CHARACTER: if (e->expr_type == EXPR_SUBSTRING && e->ref) ! { ! int start, end; ! ! gfc_extract_int (e->ref->u.ss.start, &start); ! gfc_extract_int (e->ref->u.ss.end, &end); ! return size_character (MAX(end - start + 1, 0)); ! } else ! return size_character (e->value.character.length); case BT_HOLLERITH: return e->representation.length; case BT_DERIVED: --- 102,116 ---- return size_logical (e->ts.kind); case BT_CHARACTER: if (e->expr_type == EXPR_SUBSTRING && e->ref) ! { ! int start, end; ! ! gfc_extract_int (e->ref->u.ss.start, &start); ! gfc_extract_int (e->ref->u.ss.end, &end); ! return size_character (MAX(end - start + 1, 0), e->ts.kind); ! } else ! return size_character (e->value.character.length, e->ts.kind); case BT_HOLLERITH: return e->representation.length; case BT_DERIVED: *************** encode_logical (int kind, int logical, u *** 182,193 **** } ! static int ! encode_character (int length, char *string, unsigned char *buffer, ! size_t buffer_size) { ! gcc_assert (buffer_size >= size_character (length)); ! memcpy (buffer, string, length); return length; } --- 183,202 ---- } ! int ! gfc_encode_character (int kind, int length, const gfc_char_t *string, ! unsigned char *buffer, size_t buffer_size) { ! size_t elsize = size_character (1, kind); ! tree type = gfc_get_char_type (kind); ! int i; ! ! gcc_assert (buffer_size >= size_character (length, kind)); ! ! for (i = 0; i < length; i++) ! native_encode_expr (build_int_cst (type, string[i]), &buffer[i*elsize], ! elsize); ! return length; } *************** gfc_target_encode_expr (gfc_expr *source *** 264,272 **** buffer_size); case BT_CHARACTER: if (source->expr_type == EXPR_CONSTANT || source->ref == NULL) ! return encode_character (source->value.character.length, ! source->value.character.string, buffer, ! buffer_size); else { int start, end; --- 273,282 ---- buffer_size); case BT_CHARACTER: if (source->expr_type == EXPR_CONSTANT || source->ref == NULL) ! return gfc_encode_character (source->ts.kind, ! source->value.character.length, ! source->value.character.string, ! buffer, buffer_size); else { int start, end; *************** gfc_target_encode_expr (gfc_expr *source *** 274,283 **** gcc_assert (source->expr_type == EXPR_SUBSTRING); gfc_extract_int (source->ref->u.ss.start, &start); gfc_extract_int (source->ref->u.ss.end, &end); ! return encode_character (MAX(end - start + 1, 0), ! &source->value.character.string[start-1], ! buffer, buffer_size); } case BT_DERIVED: return encode_derived (source, buffer, buffer_size); default: --- 284,294 ---- gcc_assert (source->expr_type == EXPR_SUBSTRING); gfc_extract_int (source->ref->u.ss.start, &start); gfc_extract_int (source->ref->u.ss.end, &end); ! return gfc_encode_character (source->ts.kind, MAX(end - start + 1, 0), ! &source->value.character.string[start-1], ! buffer, buffer_size); } + case BT_DERIVED: return encode_derived (source, buffer, buffer_size); default: *************** gfc_interpret_logical (int kind, unsigne *** 380,397 **** int ! gfc_interpret_character (unsigned char *buffer, size_t buffer_size, gfc_expr *result) { if (result->ts.cl && result->ts.cl->length) result->value.character.length = ! (int)mpz_get_ui (result->ts.cl->length->value.integer); ! gcc_assert (buffer_size >= size_character (result->value.character.length)); result->value.character.string = ! gfc_getmem (result->value.character.length + 1); ! memcpy (result->value.character.string, buffer, ! result->value.character.length); ! result->value.character.string [result->value.character.length] = '\0'; return result->value.character.length; } --- 391,433 ---- int ! gfc_interpret_character (unsigned char *buffer, size_t buffer_size, ! gfc_expr *result) { + int i; + if (result->ts.cl && result->ts.cl->length) result->value.character.length = ! (int) mpz_get_ui (result->ts.cl->length->value.integer); ! gcc_assert (buffer_size >= size_character (result->value.character.length, ! result->ts.kind)); result->value.character.string = ! gfc_get_wide_string (result->value.character.length + 1); ! ! if (result->ts.kind == gfc_default_character_kind) ! for (i = 0; i < result->value.character.length; i++) ! result->value.character.string[i] = (gfc_char_t) buffer[i]; ! else ! { ! mpz_t integer; ! unsigned bytes = size_character (1, result->ts.kind); ! mpz_init (integer); ! gcc_assert (bytes <= sizeof (unsigned long)); ! ! for (i = 0; i < result->value.character.length; i++) ! { ! gfc_conv_tree_to_mpz (integer, ! native_interpret_expr (gfc_get_char_type (result->ts.kind), ! &buffer[bytes*i], buffer_size-bytes*i)); ! result->value.character.string[i] ! = (gfc_char_t) mpz_get_ui (integer); ! } ! ! mpz_clear (integer); ! } ! ! result->value.character.string[result->value.character.length] = '\0'; return result->value.character.length; } *************** gfc_target_interpret_expr (unsigned char *** 510,520 **** } if (result->ts.type == BT_CHARACTER) ! result->representation.string = result->value.character.string; else { result->representation.string = ! gfc_getmem (result->representation.length + 1); memcpy (result->representation.string, buffer, result->representation.length); result->representation.string[result->representation.length] = '\0'; --- 546,558 ---- } if (result->ts.type == BT_CHARACTER) ! result->representation.string ! = gfc_widechar_to_char (result->value.character.string, ! result->value.character.length); else { result->representation.string = ! (char *) gfc_getmem (result->representation.length + 1); memcpy (result->representation.string, buffer, result->representation.length); result->representation.string[result->representation.length] = '\0'; diff -Nrcpad gcc-4.3.3/gcc/fortran/target-memory.h gcc-4.4.0/gcc/fortran/target-memory.h *** gcc-4.3.3/gcc/fortran/target-memory.h Thu Dec 20 08:13:09 2007 --- gcc-4.4.0/gcc/fortran/target-memory.h Sun May 18 22:45:05 2008 *************** *** 1,5 **** /* Simulate storage of variables into target memory, header. ! Copyright (C) 2007 Free Software Foundation, Inc. Contributed by Paul Thomas and Brooks Moses --- 1,5 ---- /* Simulate storage of variables into target memory, header. ! Copyright (C) 2007, 2008 Free Software Foundation, Inc. Contributed by Paul Thomas and Brooks Moses *************** bool gfc_convert_boz (gfc_expr *, gfc_ty *** 31,36 **** --- 31,38 ---- size_t gfc_target_expr_size (gfc_expr *); /* Write a constant expression in binary form to a target buffer. */ + int gfc_encode_character (int, int, const gfc_char_t *, unsigned char *, + size_t); int gfc_target_encode_expr (gfc_expr *, unsigned char *, size_t); /* Read a target buffer into a constant expression. */ diff -Nrcpad gcc-4.3.3/gcc/fortran/trans-array.c gcc-4.4.0/gcc/fortran/trans-array.c *** gcc-4.3.3/gcc/fortran/trans-array.c Sat Nov 29 20:42:22 2008 --- gcc-4.4.0/gcc/fortran/trans-array.c Thu Feb 26 06:23:42 2009 *************** *** 1,5 **** /* Array translation routines ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook and Steven Bosscher --- 1,5 ---- /* Array translation routines ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Paul Brook and Steven Bosscher *************** along with GCC; see the file COPYING3. *** 39,45 **** In fortran all the rhs values of an assignment must be evaluated before any assignments take place. This can require a temporary array to store the values. We also require a temporary when we are passing array expressions ! or vector subecripts as procedure parameters. Array sections are passed without copying to a temporary. These use the scalarizer to determine the shape of the section. The flag --- 39,45 ---- In fortran all the rhs values of an assignment must be evaluated before any assignments take place. This can require a temporary array to store the values. We also require a temporary when we are passing array expressions ! or vector subscripts as procedure parameters. Array sections are passed without copying to a temporary. These use the scalarizer to determine the shape of the section. The flag *************** along with GCC; see the file COPYING3. *** 80,86 **** #include "system.h" #include "coretypes.h" #include "tree.h" ! #include "tree-gimple.h" #include "ggc.h" #include "toplev.h" #include "real.h" --- 80,86 ---- #include "system.h" #include "coretypes.h" #include "tree.h" ! #include "gimple.h" #include "ggc.h" #include "toplev.h" #include "real.h" *************** gfc_conv_descriptor_data_get (tree desc) *** 149,155 **** field = TYPE_FIELDS (type); gcc_assert (DATA_FIELD == 0); ! t = build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); t = fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), t); return t; --- 149,155 ---- field = TYPE_FIELDS (type); gcc_assert (DATA_FIELD == 0); ! t = fold_build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); t = fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), t); return t; *************** gfc_conv_descriptor_data_get (tree desc) *** 161,172 **** This function gets called through the following macros: gfc_conv_descriptor_data_set ! gfc_conv_descriptor_data_set_tuples. */ void ! gfc_conv_descriptor_data_set_internal (stmtblock_t *block, ! tree desc, tree value, ! bool tuples_p) { tree field, type, t; --- 161,170 ---- This function gets called through the following macros: gfc_conv_descriptor_data_set ! gfc_conv_descriptor_data_set. */ void ! gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value) { tree field, type, t; *************** gfc_conv_descriptor_data_set_internal (s *** 176,183 **** field = TYPE_FIELDS (type); gcc_assert (DATA_FIELD == 0); ! t = build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); ! gfc_add_modify (block, t, fold_convert (TREE_TYPE (field), value), tuples_p); } --- 174,181 ---- field = TYPE_FIELDS (type); gcc_assert (DATA_FIELD == 0); ! t = fold_build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); ! gfc_add_modify (block, t, fold_convert (TREE_TYPE (field), value)); } *************** gfc_conv_descriptor_data_addr (tree desc *** 195,201 **** field = TYPE_FIELDS (type); gcc_assert (DATA_FIELD == 0); ! t = build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); return build_fold_addr_expr (t); } --- 193,199 ---- field = TYPE_FIELDS (type); gcc_assert (DATA_FIELD == 0); ! t = fold_build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); return build_fold_addr_expr (t); } *************** gfc_conv_descriptor_offset (tree desc) *** 211,217 **** field = gfc_advance_chain (TYPE_FIELDS (type), OFFSET_FIELD); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); ! return build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); } tree --- 209,216 ---- field = gfc_advance_chain (TYPE_FIELDS (type), OFFSET_FIELD); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); ! return fold_build3 (COMPONENT_REF, TREE_TYPE (field), ! desc, field, NULL_TREE); } tree *************** gfc_conv_descriptor_dtype (tree desc) *** 226,232 **** field = gfc_advance_chain (TYPE_FIELDS (type), DTYPE_FIELD); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); ! return build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); } static tree --- 225,232 ---- field = gfc_advance_chain (TYPE_FIELDS (type), DTYPE_FIELD); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); ! return fold_build3 (COMPONENT_REF, TREE_TYPE (field), ! desc, field, NULL_TREE); } static tree *************** gfc_conv_descriptor_dimension (tree desc *** 244,250 **** && TREE_CODE (TREE_TYPE (field)) == ARRAY_TYPE && TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == RECORD_TYPE); ! tmp = build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); tmp = gfc_build_array_ref (tmp, dim, NULL); return tmp; } --- 244,251 ---- && TREE_CODE (TREE_TYPE (field)) == ARRAY_TYPE && TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == RECORD_TYPE); ! tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field), ! desc, field, NULL_TREE); tmp = gfc_build_array_ref (tmp, dim, NULL); return tmp; } *************** gfc_conv_descriptor_stride (tree desc, t *** 260,266 **** field = gfc_advance_chain (field, STRIDE_SUBFIELD); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); ! tmp = build3 (COMPONENT_REF, TREE_TYPE (field), tmp, field, NULL_TREE); return tmp; } --- 261,268 ---- field = gfc_advance_chain (field, STRIDE_SUBFIELD); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); ! tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field), ! tmp, field, NULL_TREE); return tmp; } *************** gfc_conv_descriptor_lbound (tree desc, t *** 275,281 **** field = gfc_advance_chain (field, LBOUND_SUBFIELD); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); ! tmp = build3 (COMPONENT_REF, TREE_TYPE (field), tmp, field, NULL_TREE); return tmp; } --- 277,284 ---- field = gfc_advance_chain (field, LBOUND_SUBFIELD); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); ! tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field), ! tmp, field, NULL_TREE); return tmp; } *************** gfc_conv_descriptor_ubound (tree desc, t *** 290,296 **** field = gfc_advance_chain (field, UBOUND_SUBFIELD); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); ! tmp = build3 (COMPONENT_REF, TREE_TYPE (field), tmp, field, NULL_TREE); return tmp; } --- 293,300 ---- field = gfc_advance_chain (field, UBOUND_SUBFIELD); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); ! tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field), ! tmp, field, NULL_TREE); return tmp; } *************** gfc_build_null_descriptor (tree type) *** 310,316 **** /* Set a NULL data pointer. */ tmp = build_constructor_single (type, field, null_pointer_node); TREE_CONSTANT (tmp) = 1; - TREE_INVARIANT (tmp) = 1; /* All other fields are ignored. */ return tmp; --- 314,319 ---- *************** gfc_set_loop_bounds_from_array_spec (gfc *** 467,480 **** gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]); gfc_add_block_to_block (&se->pre, &tmpse.pre); gfc_add_block_to_block (&se->post, &tmpse.post); ! lower = tmpse.expr; /* ...and the upper bound. */ gfc_init_se (&tmpse, NULL); gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]); gfc_add_block_to_block (&se->pre, &tmpse.pre); gfc_add_block_to_block (&se->post, &tmpse.post); ! upper = tmpse.expr; /* Set the upper bound of the loop to UPPER - LOWER. */ tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, upper, lower); --- 470,483 ---- gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]); gfc_add_block_to_block (&se->pre, &tmpse.pre); gfc_add_block_to_block (&se->post, &tmpse.post); ! lower = fold_convert (gfc_array_index_type, tmpse.expr); /* ...and the upper bound. */ gfc_init_se (&tmpse, NULL); gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]); gfc_add_block_to_block (&se->pre, &tmpse.pre); gfc_add_block_to_block (&se->post, &tmpse.post); ! upper = fold_convert (gfc_array_index_type, tmpse.expr); /* Set the upper bound of the loop to UPPER - LOWER. */ tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, upper, lower); *************** gfc_set_loop_bounds_from_array_spec (gfc *** 490,503 **** callee will allocate the array. If DEALLOC is true, also generate code to free the array afterwards. Initialization code is added to PRE and finalization code to POST. DYNAMIC is true if the caller may want to extend the array later using realloc. This prevents us from putting the array on the stack. */ static void gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post, ! gfc_ss_info * info, tree size, tree nelem, ! bool dynamic, bool dealloc) { tree tmp; tree desc; --- 493,509 ---- callee will allocate the array. If DEALLOC is true, also generate code to free the array afterwards. + If INITIAL is not NULL, it is packed using internal_pack and the result used + as data instead of allocating a fresh, unitialized area of memory. + Initialization code is added to PRE and finalization code to POST. DYNAMIC is true if the caller may want to extend the array later using realloc. This prevents us from putting the array on the stack. */ static void gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post, ! gfc_ss_info * info, tree size, tree nelem, ! tree initial, bool dynamic, bool dealloc) { tree tmp; tree desc; *************** gfc_trans_allocate_array_storage (stmtbl *** 514,520 **** else { /* Allocate the temporary. */ ! onstack = !dynamic && gfc_can_put_var_on_stack (size); if (onstack) { --- 520,527 ---- else { /* Allocate the temporary. */ ! onstack = !dynamic && initial == NULL_TREE ! && gfc_can_put_var_on_stack (size); if (onstack) { *************** gfc_trans_allocate_array_storage (stmtbl *** 531,539 **** } else { ! /* Allocate memory to hold the data. */ ! tmp = gfc_call_malloc (pre, NULL, size); ! tmp = gfc_evaluate_now (tmp, pre); gfc_conv_descriptor_data_set (pre, desc, tmp); } } --- 538,590 ---- } else { ! /* Allocate memory to hold the data or call internal_pack. */ ! if (initial == NULL_TREE) ! { ! tmp = gfc_call_malloc (pre, NULL, size); ! tmp = gfc_evaluate_now (tmp, pre); ! } ! else ! { ! tree packed; ! tree source_data; ! tree was_packed; ! stmtblock_t do_copying; ! ! tmp = TREE_TYPE (initial); /* Pointer to descriptor. */ ! gcc_assert (TREE_CODE (tmp) == POINTER_TYPE); ! tmp = TREE_TYPE (tmp); /* The descriptor itself. */ ! tmp = gfc_get_element_type (tmp); ! gcc_assert (tmp == gfc_get_element_type (TREE_TYPE (desc))); ! packed = gfc_create_var (build_pointer_type (tmp), "data"); ! ! tmp = build_call_expr (gfor_fndecl_in_pack, 1, initial); ! tmp = fold_convert (TREE_TYPE (packed), tmp); ! gfc_add_modify (pre, packed, tmp); ! ! tmp = build_fold_indirect_ref (initial); ! source_data = gfc_conv_descriptor_data_get (tmp); ! ! /* internal_pack may return source->data without any allocation ! or copying if it is already packed. If that's the case, we ! need to allocate and copy manually. */ ! ! gfc_start_block (&do_copying); ! tmp = gfc_call_malloc (&do_copying, NULL, size); ! tmp = fold_convert (TREE_TYPE (packed), tmp); ! gfc_add_modify (&do_copying, packed, tmp); ! tmp = gfc_build_memcpy_call (packed, source_data, size); ! gfc_add_expr_to_block (&do_copying, tmp); ! ! was_packed = fold_build2 (EQ_EXPR, boolean_type_node, ! packed, source_data); ! tmp = gfc_finish_block (&do_copying); ! tmp = build3_v (COND_EXPR, was_packed, tmp, build_empty_stmt ()); ! gfc_add_expr_to_block (pre, tmp); ! ! tmp = fold_convert (pvoid_type_node, packed); ! } ! gfc_conv_descriptor_data_set (pre, desc, tmp); } } *************** gfc_trans_allocate_array_storage (stmtbl *** 542,548 **** /* The offset is zero because we create temporaries with a zero lower bound. */ tmp = gfc_conv_descriptor_offset (desc); ! gfc_add_modify_expr (pre, tmp, gfc_index_zero_node); if (dealloc && !onstack) { --- 593,599 ---- /* The offset is zero because we create temporaries with a zero lower bound. */ tmp = gfc_conv_descriptor_offset (desc); ! gfc_add_modify (pre, tmp, gfc_index_zero_node); if (dealloc && !onstack) { *************** gfc_trans_allocate_array_storage (stmtbl *** 564,577 **** fields of info if known. Returns the size of the array, or NULL for a callee allocated array. ! PRE, POST, DYNAMIC and DEALLOC are as for gfc_trans_allocate_array_storage. */ tree gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_loopinfo * loop, gfc_ss_info * info, ! tree eltype, bool dynamic, bool dealloc, ! bool callee_alloc) { tree type; tree desc; --- 615,629 ---- fields of info if known. Returns the size of the array, or NULL for a callee allocated array. ! PRE, POST, INITIAL, DYNAMIC and DEALLOC are as for ! gfc_trans_allocate_array_storage. */ tree gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_loopinfo * loop, gfc_ss_info * info, ! tree eltype, tree initial, bool dynamic, ! bool dealloc, bool callee_alloc, locus * where) { tree type; tree desc; *************** gfc_trans_create_temp_array (stmtblock_t *** 584,593 **** int dim; gcc_assert (info->dimen > 0); /* Set the lower bound to zero. */ for (dim = 0; dim < info->dimen; dim++) { ! n = loop->order[dim]; /* Callee allocated arrays may not have a known bound yet. */ if (loop->to[n]) loop->to[n] = gfc_evaluate_now (fold_build2 (MINUS_EXPR, --- 636,649 ---- int dim; gcc_assert (info->dimen > 0); + + if (gfc_option.warn_array_temp && where) + gfc_warning ("Creating array temporary at %L", where); + /* Set the lower bound to zero. */ for (dim = 0; dim < info->dimen; dim++) { ! n = loop->order[dim]; /* Callee allocated arrays may not have a known bound yet. */ if (loop->to[n]) loop->to[n] = gfc_evaluate_now (fold_build2 (MINUS_EXPR, *************** gfc_trans_create_temp_array (stmtblock_t *** 614,620 **** /* Fill in the array dtype. */ tmp = gfc_conv_descriptor_dtype (desc); ! gfc_add_modify_expr (pre, tmp, gfc_get_dtype (TREE_TYPE (desc))); /* Fill in the bounds and stride. This is a packed array, so: --- 670,676 ---- /* Fill in the array dtype. */ tmp = gfc_conv_descriptor_dtype (desc); ! gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc))); /* Fill in the bounds and stride. This is a packed array, so: *************** gfc_trans_create_temp_array (stmtblock_t *** 624,630 **** { stride[n] = size delta = ubound[n] + 1 - lbound[n]; ! size = size * delta; } size = size * sizeof(element); */ --- 680,686 ---- { stride[n] = size delta = ubound[n] + 1 - lbound[n]; ! size = size * delta; } size = size * sizeof(element); */ *************** gfc_trans_create_temp_array (stmtblock_t *** 643,667 **** for (n = 0; n < info->dimen; n++) { if (size == NULL_TREE) ! { /* For a callee allocated array express the loop bounds in terms of the descriptor fields. */ ! tmp = build2 (MINUS_EXPR, gfc_array_index_type, ! gfc_conv_descriptor_ubound (desc, gfc_rank_cst[n]), ! gfc_conv_descriptor_lbound (desc, gfc_rank_cst[n])); ! loop->to[n] = tmp; ! continue; ! } ! /* Store the stride and bound components in the descriptor. */ tmp = gfc_conv_descriptor_stride (desc, gfc_rank_cst[n]); ! gfc_add_modify_expr (pre, tmp, size); tmp = gfc_conv_descriptor_lbound (desc, gfc_rank_cst[n]); ! gfc_add_modify_expr (pre, tmp, gfc_index_zero_node); tmp = gfc_conv_descriptor_ubound (desc, gfc_rank_cst[n]); ! gfc_add_modify_expr (pre, tmp, loop->to[n]); tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, loop->to[n], gfc_index_one_node); --- 699,724 ---- for (n = 0; n < info->dimen; n++) { if (size == NULL_TREE) ! { /* For a callee allocated array express the loop bounds in terms of the descriptor fields. */ ! tmp = ! fold_build2 (MINUS_EXPR, gfc_array_index_type, ! gfc_conv_descriptor_ubound (desc, gfc_rank_cst[n]), ! gfc_conv_descriptor_lbound (desc, gfc_rank_cst[n])); ! loop->to[n] = tmp; ! continue; ! } ! /* Store the stride and bound components in the descriptor. */ tmp = gfc_conv_descriptor_stride (desc, gfc_rank_cst[n]); ! gfc_add_modify (pre, tmp, size); tmp = gfc_conv_descriptor_lbound (desc, gfc_rank_cst[n]); ! gfc_add_modify (pre, tmp, gfc_index_zero_node); tmp = gfc_conv_descriptor_ubound (desc, gfc_rank_cst[n]); ! gfc_add_modify (pre, tmp, loop->to[n]); tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, loop->to[n], gfc_index_one_node); *************** gfc_trans_create_temp_array (stmtblock_t *** 700,707 **** size = NULL_TREE; } ! gfc_trans_allocate_array_storage (pre, post, info, size, nelem, dynamic, ! dealloc); if (info->dimen > loop->temp_dim) loop->temp_dim = info->dimen; --- 757,764 ---- size = NULL_TREE; } ! gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial, ! dynamic, dealloc); if (info->dimen > loop->temp_dim) loop->temp_dim = info->dimen; *************** gfc_conv_array_transpose (gfc_se * se, g *** 746,752 **** se->expr = dest; /* Copy across the dtype field. */ ! gfc_add_modify_expr (&se->pre, gfc_conv_descriptor_dtype (dest), gfc_conv_descriptor_dtype (src)); --- 803,809 ---- se->expr = dest; /* Copy across the dtype field. */ ! gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (dest), gfc_conv_descriptor_dtype (src)); *************** gfc_conv_array_transpose (gfc_se * se, g *** 763,786 **** dest_index = gfc_rank_cst[n]; src_index = gfc_rank_cst[1 - n]; ! gfc_add_modify_expr (&se->pre, gfc_conv_descriptor_stride (dest, dest_index), gfc_conv_descriptor_stride (src, src_index)); ! gfc_add_modify_expr (&se->pre, gfc_conv_descriptor_lbound (dest, dest_index), gfc_conv_descriptor_lbound (src, src_index)); ! gfc_add_modify_expr (&se->pre, gfc_conv_descriptor_ubound (dest, dest_index), gfc_conv_descriptor_ubound (src, src_index)); if (!loop->to[n]) { gcc_assert (integer_zerop (loop->from[n])); ! loop->to[n] = build2 (MINUS_EXPR, gfc_array_index_type, ! gfc_conv_descriptor_ubound (dest, dest_index), ! gfc_conv_descriptor_lbound (dest, dest_index)); } } --- 820,844 ---- dest_index = gfc_rank_cst[n]; src_index = gfc_rank_cst[1 - n]; ! gfc_add_modify (&se->pre, gfc_conv_descriptor_stride (dest, dest_index), gfc_conv_descriptor_stride (src, src_index)); ! gfc_add_modify (&se->pre, gfc_conv_descriptor_lbound (dest, dest_index), gfc_conv_descriptor_lbound (src, src_index)); ! gfc_add_modify (&se->pre, gfc_conv_descriptor_ubound (dest, dest_index), gfc_conv_descriptor_ubound (src, src_index)); if (!loop->to[n]) { gcc_assert (integer_zerop (loop->from[n])); ! loop->to[n] = ! fold_build2 (MINUS_EXPR, gfc_array_index_type, ! gfc_conv_descriptor_ubound (dest, dest_index), ! gfc_conv_descriptor_lbound (dest, dest_index)); } } *************** gfc_conv_array_transpose (gfc_se * se, g *** 796,802 **** else dest_info->offset = gfc_index_zero_node; ! gfc_add_modify_expr (&se->pre, gfc_conv_descriptor_offset (dest), dest_info->offset); --- 854,860 ---- else dest_info->offset = gfc_index_zero_node; ! gfc_add_modify (&se->pre, gfc_conv_descriptor_offset (dest), dest_info->offset); *************** gfc_grow_array (stmtblock_t * pblock, tr *** 839,855 **** ubound = gfc_conv_descriptor_ubound (desc, gfc_rank_cst[0]); /* Add EXTRA to the upper bound. */ ! tmp = build2 (PLUS_EXPR, gfc_array_index_type, ubound, extra); ! gfc_add_modify_expr (pblock, ubound, tmp); /* Get the value of the current data pointer. */ arg0 = gfc_conv_descriptor_data_get (desc); /* Calculate the new array size. */ size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc))); ! tmp = build2 (PLUS_EXPR, gfc_array_index_type, ubound, gfc_index_one_node); ! arg1 = build2 (MULT_EXPR, size_type_node, fold_convert (size_type_node, tmp), ! fold_convert (size_type_node, size)); /* Call the realloc() function. */ tmp = gfc_call_realloc (pblock, arg0, arg1); --- 897,915 ---- ubound = gfc_conv_descriptor_ubound (desc, gfc_rank_cst[0]); /* Add EXTRA to the upper bound. */ ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ubound, extra); ! gfc_add_modify (pblock, ubound, tmp); /* Get the value of the current data pointer. */ arg0 = gfc_conv_descriptor_data_get (desc); /* Calculate the new array size. */ size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc))); ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! ubound, gfc_index_one_node); ! arg1 = fold_build2 (MULT_EXPR, size_type_node, ! fold_convert (size_type_node, tmp), ! fold_convert (size_type_node, size)); /* Call the realloc() function. */ tmp = gfc_call_realloc (pblock, arg0, arg1); *************** gfc_put_offset_into_var (stmtblock_t * p *** 948,969 **** /* We should have already created the offset variable. We cannot create it here because we may be in an inner scope. */ gcc_assert (*offsetvar != NULL_TREE); ! gfc_add_modify_expr (pblock, *offsetvar, *poffset); *poffset = *offsetvar; TREE_USED (*offsetvar) = 1; } ! /* Assign an element of an array constructor. */ static bool first_len; static tree first_len_val; static void gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc, tree offset, gfc_se * se, gfc_expr * expr) { tree tmp; - tree esize; gfc_conv_expr (se, expr); --- 1008,1029 ---- /* We should have already created the offset variable. We cannot create it here because we may be in an inner scope. */ gcc_assert (*offsetvar != NULL_TREE); ! gfc_add_modify (pblock, *offsetvar, *poffset); *poffset = *offsetvar; TREE_USED (*offsetvar) = 1; } ! /* Variables needed for bounds-checking. */ static bool first_len; static tree first_len_val; + static bool typespec_chararray_ctor; static void gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc, tree offset, gfc_se * se, gfc_expr * expr) { tree tmp; gfc_conv_expr (se, expr); *************** gfc_trans_array_ctor_element (stmtblock_ *** 971,1003 **** tmp = build_fold_indirect_ref (gfc_conv_descriptor_data_get (desc)); tmp = gfc_build_array_ref (tmp, offset, NULL); - esize = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc))); - esize = fold_convert (gfc_charlen_type_node, esize); - if (expr->ts.type == BT_CHARACTER) { gfc_conv_string_parameter (se); if (POINTER_TYPE_P (TREE_TYPE (tmp))) { /* The temporary is an array of pointers. */ se->expr = fold_convert (TREE_TYPE (tmp), se->expr); ! gfc_add_modify_expr (&se->pre, tmp, se->expr); } else { /* The temporary is an array of string values. */ ! tmp = gfc_build_addr_expr (pchar_type_node, tmp); /* We know the temporary and the value will be the same length, so can use memcpy. */ ! gfc_trans_string_copy (&se->pre, esize, tmp, ! se->string_length, ! se->expr); } ! if (flag_bounds_check) { if (first_len) { ! gfc_add_modify_expr (&se->pre, first_len_val, se->string_length); first_len = false; } --- 1031,1068 ---- tmp = build_fold_indirect_ref (gfc_conv_descriptor_data_get (desc)); tmp = gfc_build_array_ref (tmp, offset, NULL); if (expr->ts.type == BT_CHARACTER) { + int i = gfc_validate_kind (BT_CHARACTER, expr->ts.kind, false); + tree esize; + + esize = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc))); + esize = fold_convert (gfc_charlen_type_node, esize); + esize = fold_build2 (TRUNC_DIV_EXPR, gfc_charlen_type_node, esize, + build_int_cst (gfc_charlen_type_node, + gfc_character_kinds[i].bit_size / 8)); + gfc_conv_string_parameter (se); if (POINTER_TYPE_P (TREE_TYPE (tmp))) { /* The temporary is an array of pointers. */ se->expr = fold_convert (TREE_TYPE (tmp), se->expr); ! gfc_add_modify (&se->pre, tmp, se->expr); } else { /* The temporary is an array of string values. */ ! tmp = gfc_build_addr_expr (gfc_get_pchar_type (expr->ts.kind), tmp); /* We know the temporary and the value will be the same length, so can use memcpy. */ ! gfc_trans_string_copy (&se->pre, esize, tmp, expr->ts.kind, ! se->string_length, se->expr, expr->ts.kind); } ! if (flag_bounds_check && !typespec_chararray_ctor) { if (first_len) { ! gfc_add_modify (&se->pre, first_len_val, se->string_length); first_len = false; } *************** gfc_trans_array_ctor_element (stmtblock_ *** 1008,1014 **** tree cond = fold_build2 (NE_EXPR, boolean_type_node, first_len_val, se->string_length); gfc_trans_runtime_check ! (cond, &se->pre, &expr->where, "Different CHARACTER lengths (%ld/%ld) in array constructor", fold_convert (long_integer_type_node, first_len_val), fold_convert (long_integer_type_node, se->string_length)); --- 1073,1079 ---- tree cond = fold_build2 (NE_EXPR, boolean_type_node, first_len_val, se->string_length); gfc_trans_runtime_check ! (true, false, cond, &se->pre, &expr->where, "Different CHARACTER lengths (%ld/%ld) in array constructor", fold_convert (long_integer_type_node, first_len_val), fold_convert (long_integer_type_node, se->string_length)); *************** gfc_trans_array_ctor_element (stmtblock_ *** 1019,1025 **** { /* TODO: Should the frontend already have done this conversion? */ se->expr = fold_convert (TREE_TYPE (tmp), se->expr); ! gfc_add_modify_expr (&se->pre, tmp, se->expr); } gfc_add_block_to_block (pblock, &se->pre); --- 1084,1090 ---- { /* TODO: Should the frontend already have done this conversion? */ se->expr = fold_convert (TREE_TYPE (tmp), se->expr); ! gfc_add_modify (&se->pre, tmp, se->expr); } gfc_add_block_to_block (pblock, &se->pre); *************** gfc_trans_array_constructor_subarray (st *** 1060,1066 **** /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop); /* Make sure the constructed array has room for the new data. */ if (dynamic) --- 1125,1131 ---- /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop, &expr->where); /* Make sure the constructed array has room for the new data. */ if (dynamic) *************** gfc_trans_array_constructor_subarray (st *** 1088,1095 **** gcc_assert (se.ss == gfc_ss_terminator); /* Increment the offset. */ ! tmp = build2 (PLUS_EXPR, gfc_array_index_type, *poffset, gfc_index_one_node); ! gfc_add_modify_expr (&body, *poffset, tmp); /* Finish the loop. */ gfc_trans_scalarizing_loops (&loop, &body); --- 1153,1161 ---- gcc_assert (se.ss == gfc_ss_terminator); /* Increment the offset. */ ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! *poffset, gfc_index_one_node); ! gfc_add_modify (&body, *poffset, tmp); /* Finish the loop. */ gfc_trans_scalarizing_loops (&loop, &body); *************** gfc_trans_array_constructor_value (stmtb *** 1169,1174 **** --- 1235,1241 ---- tree init; tree bound; tree tmptype; + HOST_WIDE_INT idx = 0; p = c; list = NULL_TREE; *************** gfc_trans_array_constructor_value (stmtb *** 1178,1193 **** { gfc_init_se (&se, NULL); gfc_conv_constant (&se, p->expr); if (p->expr->ts.type == BT_CHARACTER && POINTER_TYPE_P (type)) ! { ! /* For constant character array constructors we build ! an array of pointers. */ ! se.expr = gfc_build_addr_expr (pchar_type_node, ! se.expr); ! } ! ! list = tree_cons (NULL_TREE, se.expr, list); c = p; p = p->next; } --- 1245,1261 ---- { gfc_init_se (&se, NULL); gfc_conv_constant (&se, p->expr); + + /* For constant character array constructors we build + an array of pointers. */ if (p->expr->ts.type == BT_CHARACTER && POINTER_TYPE_P (type)) ! se.expr = gfc_build_addr_expr ! (gfc_get_pchar_type (p->expr->ts.kind), ! se.expr); ! ! list = tree_cons (build_int_cst (gfc_array_index_type, ! idx++), se.expr, list); c = p; p = p->next; } *************** gfc_trans_array_constructor_value (stmtb *** 1200,1212 **** init = build_constructor_from_list (tmptype, nreverse (list)); TREE_CONSTANT (init) = 1; - TREE_INVARIANT (init) = 1; TREE_STATIC (init) = 1; /* Create a static variable to hold the data. */ tmp = gfc_create_var (tmptype, "data"); TREE_STATIC (tmp) = 1; TREE_CONSTANT (tmp) = 1; - TREE_INVARIANT (tmp) = 1; TREE_READONLY (tmp) = 1; DECL_INITIAL (tmp) = init; init = tmp; --- 1268,1278 ---- *************** gfc_trans_array_constructor_value (stmtb *** 1230,1241 **** } if (!INTEGER_CST_P (*poffset)) { ! gfc_add_modify_expr (&body, *offsetvar, *poffset); *poffset = *offsetvar; } } ! /* The frontend should already have done any expansions possible at compile-time. */ if (!c->iterator) { --- 1296,1307 ---- } if (!INTEGER_CST_P (*poffset)) { ! gfc_add_modify (&body, *offsetvar, *poffset); *poffset = *offsetvar; } } ! /* The frontend should already have done any expansions at compile-time. */ if (!c->iterator) { *************** gfc_trans_array_constructor_value (stmtb *** 1276,1288 **** /* Make a temporary, store the current value in that and return it, once the loop is done. */ tmp_loopvar = gfc_create_var (TREE_TYPE (loopvar), "loopvar"); ! gfc_add_modify_expr (pblock, tmp_loopvar, loopvar); /* Initialize the loop. */ gfc_init_se (&se, NULL); gfc_conv_expr_val (&se, c->iterator->start); gfc_add_block_to_block (pblock, &se.pre); ! gfc_add_modify_expr (pblock, loopvar, se.expr); gfc_init_se (&se, NULL); gfc_conv_expr_val (&se, c->iterator->end); --- 1342,1354 ---- /* Make a temporary, store the current value in that and return it, once the loop is done. */ tmp_loopvar = gfc_create_var (TREE_TYPE (loopvar), "loopvar"); ! gfc_add_modify (pblock, tmp_loopvar, loopvar); /* Initialize the loop. */ gfc_init_se (&se, NULL); gfc_conv_expr_val (&se, c->iterator->start); gfc_add_block_to_block (pblock, &se.pre); ! gfc_add_modify (pblock, loopvar, se.expr); gfc_init_se (&se, NULL); gfc_conv_expr_val (&se, c->iterator->end); *************** gfc_trans_array_constructor_value (stmtb *** 1321,1330 **** tmp = fold_build2 (GT_EXPR, boolean_type_node, step, build_int_cst (TREE_TYPE (step), 0)); cond = fold_build3 (COND_EXPR, boolean_type_node, tmp, ! build2 (GT_EXPR, boolean_type_node, ! loopvar, end), ! build2 (LT_EXPR, boolean_type_node, ! loopvar, end)); tmp = build1_v (GOTO_EXPR, exit_label); TREE_USED (exit_label) = 1; tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); --- 1387,1396 ---- tmp = fold_build2 (GT_EXPR, boolean_type_node, step, build_int_cst (TREE_TYPE (step), 0)); cond = fold_build3 (COND_EXPR, boolean_type_node, tmp, ! fold_build2 (GT_EXPR, boolean_type_node, ! loopvar, end), ! fold_build2 (LT_EXPR, boolean_type_node, ! loopvar, end)); tmp = build1_v (GOTO_EXPR, exit_label); TREE_USED (exit_label) = 1; tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); *************** gfc_trans_array_constructor_value (stmtb *** 1334,1341 **** gfc_add_expr_to_block (&body, loopbody); /* Increase loop variable by step. */ ! tmp = build2 (PLUS_EXPR, TREE_TYPE (loopvar), loopvar, step); ! gfc_add_modify_expr (&body, loopvar, tmp); /* Finish the loop. */ tmp = gfc_finish_block (&body); --- 1400,1407 ---- gfc_add_expr_to_block (&body, loopbody); /* Increase loop variable by step. */ ! tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (loopvar), loopvar, step); ! gfc_add_modify (&body, loopvar, tmp); /* Finish the loop. */ tmp = gfc_finish_block (&body); *************** gfc_trans_array_constructor_value (stmtb *** 1347,1353 **** gfc_add_expr_to_block (pblock, tmp); /* Restore the original value of the loop counter. */ ! gfc_add_modify_expr (pblock, loopvar, tmp_loopvar); } } mpz_clear (size); --- 1413,1419 ---- gfc_add_expr_to_block (pblock, tmp); /* Restore the original value of the loop counter. */ ! gfc_add_modify (pblock, loopvar, tmp_loopvar); } } mpz_clear (size); *************** get_array_ctor_var_strlen (gfc_expr * ex *** 1389,1396 **** mpz_init_set_ui (char_len, 1); mpz_add (char_len, char_len, ref->u.ss.end->value.integer); mpz_sub (char_len, char_len, ref->u.ss.start->value.integer); ! *len = gfc_conv_mpz_to_tree (char_len, ! gfc_default_character_kind); *len = convert (gfc_charlen_type_node, *len); mpz_clear (char_len); return; --- 1455,1461 ---- mpz_init_set_ui (char_len, 1); mpz_add (char_len, char_len, ref->u.ss.end->value.integer); mpz_sub (char_len, char_len, ref->u.ss.start->value.integer); ! *len = gfc_conv_mpz_to_tree (char_len, gfc_default_integer_kind); *len = convert (gfc_charlen_type_node, *len); mpz_clear (char_len); return; *************** get_array_ctor_all_strlen (stmtblock_t * *** 1451,1456 **** --- 1516,1524 ---- /* Figure out the string length of a character array constructor. + If len is NULL, don't calculate the length; this happens for recursive calls + when a sub-array-constructor is an element but not at the first position, + so when we're not interested in the length. Returns TRUE if all elements are character constants. */ bool *************** get_array_ctor_strlen (stmtblock_t *bloc *** 1462,1477 **** if (c == NULL) { ! *len = build_int_cstu (gfc_charlen_type_node, 0); return is_const; } ! for (; c; c = c->next) { switch (c->expr->expr_type) { case EXPR_CONSTANT: ! if (!(*len && INTEGER_CST_P (*len))) *len = build_int_cstu (gfc_charlen_type_node, c->expr->value.character.length); break; --- 1530,1549 ---- if (c == NULL) { ! if (len) ! *len = build_int_cstu (gfc_charlen_type_node, 0); return is_const; } ! /* Loop over all constructor elements to find out is_const, but in len we ! want to store the length of the first, not the last, element. We can ! of course exit the loop as soon as is_const is found to be false. */ ! for (; c && is_const; c = c->next) { switch (c->expr->expr_type) { case EXPR_CONSTANT: ! if (len && !(*len && INTEGER_CST_P (*len))) *len = build_int_cstu (gfc_charlen_type_node, c->expr->value.character.length); break; *************** get_array_ctor_strlen (stmtblock_t *bloc *** 1483,1496 **** case EXPR_VARIABLE: is_const = false; ! get_array_ctor_var_strlen (c->expr, len); break; default: is_const = false; ! get_array_ctor_all_strlen (block, c->expr, len); break; } } return is_const; --- 1555,1573 ---- case EXPR_VARIABLE: is_const = false; ! if (len) ! get_array_ctor_var_strlen (c->expr, len); break; default: is_const = false; ! if (len) ! get_array_ctor_all_strlen (block, c->expr, len); break; } + + /* After the first iteration, we don't want the length modified. */ + len = NULL; } return is_const; *************** gfc_build_constant_array_constructor (gf *** 1541,1550 **** { gfc_init_se (&se, NULL); gfc_conv_constant (&se, c->expr); ! if (c->expr->ts.type == BT_CHARACTER ! && POINTER_TYPE_P (type)) ! se.expr = gfc_build_addr_expr (pchar_type_node, se.expr); ! list = tree_cons (NULL_TREE, se.expr, list); c = c->next; nelem++; } --- 1618,1628 ---- { gfc_init_se (&se, NULL); gfc_conv_constant (&se, c->expr); ! if (c->expr->ts.type == BT_CHARACTER && POINTER_TYPE_P (type)) ! se.expr = gfc_build_addr_expr (gfc_get_pchar_type (c->expr->ts.kind), ! se.expr); ! list = tree_cons (build_int_cst (gfc_array_index_type, nelem), ! se.expr, list); c = c->next; nelem++; } *************** gfc_build_constant_array_constructor (gf *** 1575,1587 **** init = build_constructor_from_list (tmptype, nreverse (list)); TREE_CONSTANT (init) = 1; - TREE_INVARIANT (init) = 1; TREE_STATIC (init) = 1; tmp = gfc_create_var (tmptype, "A"); TREE_STATIC (tmp) = 1; TREE_CONSTANT (tmp) = 1; - TREE_INVARIANT (tmp) = 1; TREE_READONLY (tmp) = 1; DECL_INITIAL (tmp) = init; --- 1653,1663 ---- *************** gfc_trans_constant_array_constructor (gf *** 1626,1632 **** /* Helper routine of gfc_trans_array_constructor to determine if the bounds of the loop specified by LOOP are constant and simple enough to use with gfc_trans_constant_array_constructor. Returns the ! the iteration count of the loop if suitable, and NULL_TREE otherwise. */ static tree constant_array_constructor_loop_size (gfc_loopinfo * loop) --- 1702,1708 ---- /* Helper routine of gfc_trans_array_constructor to determine if the bounds of the loop specified by LOOP are constant and simple enough to use with gfc_trans_constant_array_constructor. Returns the ! iteration count of the loop if suitable, and NULL_TREE otherwise. */ static tree constant_array_constructor_loop_size (gfc_loopinfo * loop) *************** constant_array_constructor_loop_size (gf *** 1664,1670 **** simplest method. */ static void ! gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss) { gfc_constructor *c; tree offset; --- 1740,1746 ---- simplest method. */ static void ! gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) { gfc_constructor *c; tree offset; *************** gfc_trans_array_constructor (gfc_loopinf *** 1672,1679 **** tree desc; tree type; bool dynamic; ! if (flag_bounds_check && ss->expr->ts.type == BT_CHARACTER) { first_len_val = gfc_create_var (gfc_charlen_type_node, "len"); first_len = true; --- 1748,1768 ---- tree desc; tree type; bool dynamic; + bool old_first_len, old_typespec_chararray_ctor; + tree old_first_len_val; ! /* Save the old values for nested checking. */ ! old_first_len = first_len; ! old_first_len_val = first_len_val; ! old_typespec_chararray_ctor = typespec_chararray_ctor; ! ! /* Do bounds-checking here and in gfc_trans_array_ctor_element only if no ! typespec was given for the array constructor. */ ! typespec_chararray_ctor = (ss->expr->ts.cl ! && ss->expr->ts.cl->length_from_typespec); ! ! if (flag_bounds_check && ss->expr->ts.type == BT_CHARACTER ! && !typespec_chararray_ctor) { first_len_val = gfc_create_var (gfc_charlen_type_node, "len"); first_len = true; *************** gfc_trans_array_constructor (gfc_loopinf *** 1684,1690 **** c = ss->expr->value.constructor; if (ss->expr->ts.type == BT_CHARACTER) { ! bool const_string = get_array_ctor_strlen (&loop->pre, c, &ss->string_length); /* Complex character array constructors should have been taken care of and not end up here. */ --- 1773,1799 ---- c = ss->expr->value.constructor; if (ss->expr->ts.type == BT_CHARACTER) { ! bool const_string; ! ! /* get_array_ctor_strlen walks the elements of the constructor, if a ! typespec was given, we already know the string length and want the one ! specified there. */ ! if (typespec_chararray_ctor && ss->expr->ts.cl->length ! && ss->expr->ts.cl->length->expr_type != EXPR_CONSTANT) ! { ! gfc_se length_se; ! ! const_string = false; ! gfc_init_se (&length_se, NULL); ! gfc_conv_expr_type (&length_se, ss->expr->ts.cl->length, ! gfc_charlen_type_node); ! ss->string_length = length_se.expr; ! gfc_add_block_to_block (&loop->pre, &length_se.pre); ! gfc_add_block_to_block (&loop->post, &length_se.post); ! } ! else ! const_string = get_array_ctor_strlen (&loop->pre, c, ! &ss->string_length); /* Complex character array constructors should have been taken care of and not end up here. */ *************** gfc_trans_array_constructor (gfc_loopinf *** 1744,1756 **** if (size && compare_tree_int (size, nelem) == 0) { gfc_trans_constant_array_constructor (loop, ss, type); ! return; } } } gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info, ! type, dynamic, true, false); desc = ss->data.info.descriptor; offset = gfc_index_zero_node; --- 1853,1865 ---- if (size && compare_tree_int (size, nelem) == 0) { gfc_trans_constant_array_constructor (loop, ss, type); ! goto finish; } } } gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info, ! type, NULL_TREE, dynamic, true, false, where); desc = ss->data.info.descriptor; offset = gfc_index_zero_node; *************** gfc_trans_array_constructor (gfc_loopinf *** 1776,1781 **** --- 1885,1896 ---- gcc_unreachable (); } #endif + + finish: + /* Restore old values of globals. */ + first_len = old_first_len; + first_len_val = old_first_len_val; + typespec_chararray_ctor = old_typespec_chararray_ctor; } *************** gfc_set_vector_loop_bounds (gfc_loopinfo *** 1825,1837 **** but before the actual scalarizing loops. */ static void ! gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript) { gfc_se se; int n; ! /* TODO: This can generate bad code if there are ordering dependencies. ! eg. a callee allocated function and an unknown size constructor. */ gcc_assert (ss != NULL); for (; ss != gfc_ss_terminator; ss = ss->loop_chain) --- 1940,1953 ---- but before the actual scalarizing loops. */ static void ! gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, ! locus * where) { gfc_se se; int n; ! /* TODO: This can generate bad code if there are ordering dependencies, ! e.g., a callee allocated function and an unknown size constructor. */ gcc_assert (ss != NULL); for (; ss != gfc_ss_terminator; ss = ss->loop_chain) *************** gfc_add_loop_ss_code (gfc_loopinfo * loo *** 1879,1885 **** /* Add the expressions for scalar and vector subscripts. */ for (n = 0; n < GFC_MAX_DIMENSIONS; n++) if (ss->data.info.subscript[n]) ! gfc_add_loop_ss_code (loop, ss->data.info.subscript[n], true); gfc_set_vector_loop_bounds (loop, &ss->data.info); break; --- 1995,2002 ---- /* Add the expressions for scalar and vector subscripts. */ for (n = 0; n < GFC_MAX_DIMENSIONS; n++) if (ss->data.info.subscript[n]) ! gfc_add_loop_ss_code (loop, ss->data.info.subscript[n], true, ! where); gfc_set_vector_loop_bounds (loop, &ss->data.info); break; *************** gfc_add_loop_ss_code (gfc_loopinfo * loo *** 1922,1928 **** gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); } ! gfc_trans_array_constructor (loop, ss); break; case GFC_SS_TEMP: --- 2039,2045 ---- gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); } ! gfc_trans_array_constructor (loop, ss, where); break; case GFC_SS_TEMP: *************** gfc_trans_array_bound_check (gfc_se * se *** 2158,2164 **** else asprintf (&msg, "%s, lower bound of dimension %d exceeded (%%ld < %%ld)", gfc_msg_fault, n+1); ! gfc_trans_runtime_check (fault, &se->pre, where, msg, fold_convert (long_integer_type_node, index), fold_convert (long_integer_type_node, tmp)); gfc_free (msg); --- 2275,2281 ---- else asprintf (&msg, "%s, lower bound of dimension %d exceeded (%%ld < %%ld)", gfc_msg_fault, n+1); ! gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg, fold_convert (long_integer_type_node, index), fold_convert (long_integer_type_node, tmp)); gfc_free (msg); *************** gfc_trans_array_bound_check (gfc_se * se *** 2174,2180 **** else asprintf (&msg, "%s, upper bound of dimension %d exceeded (%%ld > %%ld)", gfc_msg_fault, n+1); ! gfc_trans_runtime_check (fault, &se->pre, where, msg, fold_convert (long_integer_type_node, index), fold_convert (long_integer_type_node, tmp)); gfc_free (msg); --- 2291,2297 ---- else asprintf (&msg, "%s, upper bound of dimension %d exceeded (%%ld > %%ld)", gfc_msg_fault, n+1); ! gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg, fold_convert (long_integer_type_node, index), fold_convert (long_integer_type_node, tmp)); gfc_free (msg); *************** gfc_conv_array_ref (gfc_se * se, gfc_arr *** 2368,2374 **** asprintf (&msg, "%s for array '%s', " "lower bound of dimension %d exceeded (%%ld < %%ld)", gfc_msg_fault, sym->name, n+1); ! gfc_trans_runtime_check (cond, &se->pre, where, msg, fold_convert (long_integer_type_node, indexse.expr), fold_convert (long_integer_type_node, tmp)); --- 2485,2491 ---- asprintf (&msg, "%s for array '%s', " "lower bound of dimension %d exceeded (%%ld < %%ld)", gfc_msg_fault, sym->name, n+1); ! gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg, fold_convert (long_integer_type_node, indexse.expr), fold_convert (long_integer_type_node, tmp)); *************** gfc_conv_array_ref (gfc_se * se, gfc_arr *** 2385,2391 **** asprintf (&msg, "%s for array '%s', " "upper bound of dimension %d exceeded (%%ld > %%ld)", gfc_msg_fault, sym->name, n+1); ! gfc_trans_runtime_check (cond, &se->pre, where, msg, fold_convert (long_integer_type_node, indexse.expr), fold_convert (long_integer_type_node, tmp)); --- 2502,2508 ---- asprintf (&msg, "%s for array '%s', " "upper bound of dimension %d exceeded (%%ld > %%ld)", gfc_msg_fault, sym->name, n+1); ! gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg, fold_convert (long_integer_type_node, indexse.expr), fold_convert (long_integer_type_node, tmp)); *************** gfc_trans_scalarized_loop_end (gfc_loopi *** 2563,2569 **** loopbody = gfc_finish_block (pbody); /* Initialize the loopvar. */ ! gfc_add_modify_expr (&loop->code[n], loop->loopvar[n], loop->from[n]); exit_label = gfc_build_label_decl (NULL_TREE); --- 2680,2686 ---- loopbody = gfc_finish_block (pbody); /* Initialize the loopvar. */ ! gfc_add_modify (&loop->code[n], loop->loopvar[n], loop->from[n]); exit_label = gfc_build_label_decl (NULL_TREE); *************** gfc_trans_scalarized_loop_end (gfc_loopi *** 2571,2577 **** gfc_init_block (&block); /* The exit condition. */ ! cond = build2 (GT_EXPR, boolean_type_node, loop->loopvar[n], loop->to[n]); tmp = build1_v (GOTO_EXPR, exit_label); TREE_USED (exit_label) = 1; tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); --- 2688,2695 ---- gfc_init_block (&block); /* The exit condition. */ ! cond = fold_build2 (GT_EXPR, boolean_type_node, ! loop->loopvar[n], loop->to[n]); tmp = build1_v (GOTO_EXPR, exit_label); TREE_USED (exit_label) = 1; tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); *************** gfc_trans_scalarized_loop_end (gfc_loopi *** 2581,2589 **** gfc_add_expr_to_block (&block, loopbody); /* Increment the loopvar. */ ! tmp = build2 (PLUS_EXPR, gfc_array_index_type, ! loop->loopvar[n], gfc_index_one_node); ! gfc_add_modify_expr (&block, loop->loopvar[n], tmp); /* Build the loop. */ tmp = gfc_finish_block (&block); --- 2699,2707 ---- gfc_add_expr_to_block (&block, loopbody); /* Increment the loopvar. */ ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! loop->loopvar[n], gfc_index_one_node); ! gfc_add_modify (&block, loop->loopvar[n], tmp); /* Build the loop. */ tmp = gfc_finish_block (&block); *************** gfc_conv_ss_startstride (gfc_loopinfo * *** 2915,2923 **** --- 3033,3045 ---- for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { + stmtblock_t inner; + if (ss->type != GFC_SS_SECTION) continue; + gfc_start_block (&inner); + /* TODO: range checking for mapped dimensions. */ info = &ss->data.info; *************** gfc_conv_ss_startstride (gfc_loopinfo * *** 2944,2950 **** asprintf (&msg, "Zero stride is not allowed, for dimension %d " "of array '%s'", info->dim[n]+1, ss->expr->symtree->name); ! gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg); gfc_free (msg); desc = ss->data.info.descriptor; --- 3066,3073 ---- asprintf (&msg, "Zero stride is not allowed, for dimension %d " "of array '%s'", info->dim[n]+1, ss->expr->symtree->name); ! gfc_trans_runtime_check (true, false, tmp, &inner, ! &ss->expr->where, msg); gfc_free (msg); desc = ss->data.info.descriptor; *************** gfc_conv_ss_startstride (gfc_loopinfo * *** 2986,2992 **** asprintf (&msg, "%s, lower bound of dimension %d of array '%s'" " exceeded (%%ld < %%ld)", gfc_msg_fault, info->dim[n]+1, ss->expr->symtree->name); ! gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg, fold_convert (long_integer_type_node, info->start[n]), fold_convert (long_integer_type_node, --- 3109,3116 ---- asprintf (&msg, "%s, lower bound of dimension %d of array '%s'" " exceeded (%%ld < %%ld)", gfc_msg_fault, info->dim[n]+1, ss->expr->symtree->name); ! gfc_trans_runtime_check (true, false, tmp, &inner, ! &ss->expr->where, msg, fold_convert (long_integer_type_node, info->start[n]), fold_convert (long_integer_type_node, *************** gfc_conv_ss_startstride (gfc_loopinfo * *** 3002,3008 **** asprintf (&msg, "%s, upper bound of dimension %d of array " "'%s' exceeded (%%ld > %%ld)", gfc_msg_fault, info->dim[n]+1, ss->expr->symtree->name); ! gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg, fold_convert (long_integer_type_node, info->start[n]), fold_convert (long_integer_type_node, ubound)); gfc_free (msg); --- 3126,3133 ---- asprintf (&msg, "%s, upper bound of dimension %d of array " "'%s' exceeded (%%ld > %%ld)", gfc_msg_fault, info->dim[n]+1, ss->expr->symtree->name); ! gfc_trans_runtime_check (true, false, tmp, &inner, ! &ss->expr->where, msg, fold_convert (long_integer_type_node, info->start[n]), fold_convert (long_integer_type_node, ubound)); gfc_free (msg); *************** gfc_conv_ss_startstride (gfc_loopinfo * *** 3024,3030 **** asprintf (&msg, "%s, lower bound of dimension %d of array '%s'" " exceeded (%%ld < %%ld)", gfc_msg_fault, info->dim[n]+1, ss->expr->symtree->name); ! gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg, fold_convert (long_integer_type_node, tmp2), fold_convert (long_integer_type_node, --- 3149,3156 ---- asprintf (&msg, "%s, lower bound of dimension %d of array '%s'" " exceeded (%%ld < %%ld)", gfc_msg_fault, info->dim[n]+1, ss->expr->symtree->name); ! gfc_trans_runtime_check (true, false, tmp, &inner, ! &ss->expr->where, msg, fold_convert (long_integer_type_node, tmp2), fold_convert (long_integer_type_node, *************** gfc_conv_ss_startstride (gfc_loopinfo * *** 3039,3045 **** asprintf (&msg, "%s, upper bound of dimension %d of array " "'%s' exceeded (%%ld > %%ld)", gfc_msg_fault, info->dim[n]+1, ss->expr->symtree->name); ! gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg, fold_convert (long_integer_type_node, tmp2), fold_convert (long_integer_type_node, ubound)); gfc_free (msg); --- 3165,3172 ---- asprintf (&msg, "%s, upper bound of dimension %d of array " "'%s' exceeded (%%ld > %%ld)", gfc_msg_fault, info->dim[n]+1, ss->expr->symtree->name); ! gfc_trans_runtime_check (true, false, tmp, &inner, ! &ss->expr->where, msg, fold_convert (long_integer_type_node, tmp2), fold_convert (long_integer_type_node, ubound)); gfc_free (msg); *************** gfc_conv_ss_startstride (gfc_loopinfo * *** 3050,3055 **** --- 3177,3184 ---- info->start[n]); tmp = fold_build2 (FLOOR_DIV_EXPR, gfc_array_index_type, tmp, info->stride[n]); + tmp = fold_build2 (MAX_EXPR, gfc_array_index_type, tmp, + build_int_cst (gfc_array_index_type, 0)); /* We remember the size of the first section, and check all the others against this. */ if (size[n]) *************** gfc_conv_ss_startstride (gfc_loopinfo * *** 3057,3086 **** tree tmp3; tmp3 = fold_build2 (NE_EXPR, boolean_type_node, tmp, size[n]); - - /* For optional arguments, only check bounds if the - argument is present. */ - if (ss->expr->symtree->n.sym->attr.optional - || ss->expr->symtree->n.sym->attr.not_always_present) - { - tree cond; - - cond = gfc_conv_expr_present (ss->expr->symtree->n.sym); - tmp3 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, - cond, tmp3); - } - asprintf (&msg, "%s, size mismatch for dimension %d " "of array '%s' (%%ld/%%ld)", gfc_msg_bounds, info->dim[n]+1, ss->expr->symtree->name); ! gfc_trans_runtime_check (tmp3, &block, &ss->expr->where, msg, fold_convert (long_integer_type_node, tmp), fold_convert (long_integer_type_node, size[n])); gfc_free (msg); } else ! size[n] = gfc_evaluate_now (tmp, &block); } } tmp = gfc_finish_block (&block); --- 3186,3216 ---- tree tmp3; tmp3 = fold_build2 (NE_EXPR, boolean_type_node, tmp, size[n]); asprintf (&msg, "%s, size mismatch for dimension %d " "of array '%s' (%%ld/%%ld)", gfc_msg_bounds, info->dim[n]+1, ss->expr->symtree->name); ! gfc_trans_runtime_check (true, false, tmp3, &inner, ! &ss->expr->where, msg, fold_convert (long_integer_type_node, tmp), fold_convert (long_integer_type_node, size[n])); gfc_free (msg); } else ! size[n] = gfc_evaluate_now (tmp, &inner); } + + tmp = gfc_finish_block (&inner); + + /* For optional arguments, only check bounds if the argument is + present. */ + if (ss->expr->symtree->n.sym->attr.optional + || ss->expr->symtree->n.sym->attr.not_always_present) + tmp = build3_v (COND_EXPR, + gfc_conv_expr_present (ss->expr->symtree->n.sym), + tmp, build_empty_stmt ()); + + gfc_add_expr_to_block (&block, tmp); + } tmp = gfc_finish_block (&block); *************** gfc_conv_resolve_dependencies (gfc_loopi *** 3169,3182 **** if (ss->type != GFC_SS_SECTION) continue; ! if (gfc_could_be_alias (dest, ss) ! || gfc_are_equivalenced_arrays (dest->expr, ss->expr)) { ! nDepend = 1; ! break; } ! ! if (dest->expr->symtree->n.sym == ss->expr->symtree->n.sym) { lref = dest->expr->ref; rref = ss->expr->ref; --- 3299,3314 ---- if (ss->type != GFC_SS_SECTION) continue; ! if (dest->expr->symtree->n.sym != ss->expr->symtree->n.sym) { ! if (gfc_could_be_alias (dest, ss) ! || gfc_are_equivalenced_arrays (dest->expr, ss->expr)) ! { ! nDepend = 1; ! break; ! } } ! else { lref = dest->expr->ref; rref = ss->expr->ref; *************** gfc_conv_resolve_dependencies (gfc_loopi *** 3249,3255 **** moved outside the loop. */ void ! gfc_conv_loop_setup (gfc_loopinfo * loop) { int n; int dim; --- 3381,3387 ---- moved outside the loop. */ void ! gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) { int n; int dim; *************** gfc_conv_loop_setup (gfc_loopinfo * loop *** 3410,3417 **** for (i = 0; i<=last; i++){...}; */ tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, loop->to[n], loop->from[n]); ! tmp = fold_build2 (TRUNC_DIV_EXPR, gfc_array_index_type, tmp, info->stride[n]); loop->to[n] = gfc_evaluate_now (tmp, &loop->pre); /* Make the loop variable start at 0. */ loop->from[n] = gfc_index_zero_node; --- 3542,3551 ---- for (i = 0; i<=last; i++){...}; */ tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, loop->to[n], loop->from[n]); ! tmp = fold_build2 (FLOOR_DIV_EXPR, gfc_array_index_type, tmp, info->stride[n]); + tmp = fold_build2 (MAX_EXPR, gfc_array_index_type, tmp, + build_int_cst (gfc_array_index_type, -1)); loop->to[n] = gfc_evaluate_now (tmp, &loop->pre); /* Make the loop variable start at 0. */ loop->from[n] = gfc_index_zero_node; *************** gfc_conv_loop_setup (gfc_loopinfo * loop *** 3421,3427 **** /* Add all the scalar code that can be taken out of the loops. This may include calculating the loop bounds, so do it before allocating the temporary. */ ! gfc_add_loop_ss_code (loop, loop->ss, false); /* If we want a temporary then create it. */ if (loop->temp_ss != NULL) --- 3555,3561 ---- /* Add all the scalar code that can be taken out of the loops. This may include calculating the loop bounds, so do it before allocating the temporary. */ ! gfc_add_loop_ss_code (loop, loop->ss, false, where); /* If we want a temporary then create it. */ if (loop->temp_ss != NULL) *************** gfc_conv_loop_setup (gfc_loopinfo * loop *** 3431,3438 **** /* Make absolutely sure that this is a complete type. */ if (loop->temp_ss->string_length) loop->temp_ss->data.temp.type ! = gfc_get_character_type_len (gfc_default_character_kind, ! loop->temp_ss->string_length); tmp = loop->temp_ss->data.temp.type; len = loop->temp_ss->string_length; --- 3565,3573 ---- /* Make absolutely sure that this is a complete type. */ if (loop->temp_ss->string_length) loop->temp_ss->data.temp.type ! = gfc_get_character_type_len_for_eltype ! (TREE_TYPE (loop->temp_ss->data.temp.type), ! loop->temp_ss->string_length); tmp = loop->temp_ss->data.temp.type; len = loop->temp_ss->string_length; *************** gfc_conv_loop_setup (gfc_loopinfo * loop *** 3441,3448 **** loop->temp_ss->type = GFC_SS_SECTION; loop->temp_ss->data.info.dimen = n; gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, ! &loop->temp_ss->data.info, tmp, false, true, ! false); } for (n = 0; n < loop->temp_dim; n++) --- 3576,3583 ---- loop->temp_ss->type = GFC_SS_SECTION; loop->temp_ss->data.info.dimen = n; gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, ! &loop->temp_ss->data.info, tmp, NULL_TREE, ! false, true, false, where); } for (n = 0; n < loop->temp_dim; n++) *************** gfc_array_init_size (tree descriptor, in *** 3538,3544 **** /* Set the dtype. */ tmp = gfc_conv_descriptor_dtype (descriptor); ! gfc_add_modify_expr (pblock, tmp, gfc_get_dtype (TREE_TYPE (descriptor))); or_expr = NULL_TREE; --- 3673,3679 ---- /* Set the dtype. */ tmp = gfc_conv_descriptor_dtype (descriptor); ! gfc_add_modify (pblock, tmp, gfc_get_dtype (TREE_TYPE (descriptor))); or_expr = NULL_TREE; *************** gfc_array_init_size (tree descriptor, in *** 3569,3583 **** } } tmp = gfc_conv_descriptor_lbound (descriptor, gfc_rank_cst[n]); ! gfc_add_modify_expr (pblock, tmp, se.expr); /* Work out the offset for this component. */ tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, se.expr, stride); offset = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp); /* Start the calculation for the size of this dimension. */ ! size = build2 (MINUS_EXPR, gfc_array_index_type, ! gfc_index_one_node, se.expr); /* Set upper bound. */ gfc_init_se (&se, NULL); --- 3704,3718 ---- } } tmp = gfc_conv_descriptor_lbound (descriptor, gfc_rank_cst[n]); ! gfc_add_modify (pblock, tmp, se.expr); /* Work out the offset for this component. */ tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, se.expr, stride); offset = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp); /* Start the calculation for the size of this dimension. */ ! size = fold_build2 (MINUS_EXPR, gfc_array_index_type, ! gfc_index_one_node, se.expr); /* Set upper bound. */ gfc_init_se (&se, NULL); *************** gfc_array_init_size (tree descriptor, in *** 3586,3596 **** gfc_add_block_to_block (pblock, &se.pre); tmp = gfc_conv_descriptor_ubound (descriptor, gfc_rank_cst[n]); ! gfc_add_modify_expr (pblock, tmp, se.expr); /* Store the stride. */ tmp = gfc_conv_descriptor_stride (descriptor, gfc_rank_cst[n]); ! gfc_add_modify_expr (pblock, tmp, stride); /* Calculate the size of this dimension. */ size = fold_build2 (PLUS_EXPR, gfc_array_index_type, se.expr, size); --- 3721,3731 ---- gfc_add_block_to_block (pblock, &se.pre); tmp = gfc_conv_descriptor_ubound (descriptor, gfc_rank_cst[n]); ! gfc_add_modify (pblock, tmp, se.expr); /* Store the stride. */ tmp = gfc_conv_descriptor_stride (descriptor, gfc_rank_cst[n]); ! gfc_add_modify (pblock, tmp, stride); /* Calculate the size of this dimension. */ size = fold_build2 (PLUS_EXPR, gfc_array_index_type, se.expr, size); *************** gfc_array_init_size (tree descriptor, in *** 3630,3640 **** var = gfc_create_var (TREE_TYPE (size), "size"); gfc_start_block (&thenblock); ! gfc_add_modify_expr (&thenblock, var, gfc_index_zero_node); thencase = gfc_finish_block (&thenblock); gfc_start_block (&elseblock); ! gfc_add_modify_expr (&elseblock, var, size); elsecase = gfc_finish_block (&elseblock); tmp = gfc_evaluate_now (or_expr, pblock); --- 3765,3775 ---- var = gfc_create_var (TREE_TYPE (size), "size"); gfc_start_block (&thenblock); ! gfc_add_modify (&thenblock, var, gfc_index_zero_node); thencase = gfc_finish_block (&thenblock); gfc_start_block (&elseblock); ! gfc_add_modify (&elseblock, var, size); elsecase = gfc_finish_block (&elseblock); tmp = gfc_evaluate_now (or_expr, pblock); *************** gfc_array_allocate (gfc_se * se, gfc_exp *** 3677,3683 **** if (!prev_ref) allocatable_array = expr->symtree->n.sym->attr.allocatable; else ! allocatable_array = prev_ref->u.c.component->allocatable; /* Figure out the size of the array. */ switch (ref->u.ar.type) --- 3812,3818 ---- if (!prev_ref) allocatable_array = expr->symtree->n.sym->attr.allocatable; else ! allocatable_array = prev_ref->u.c.component->attr.allocatable; /* Figure out the size of the array. */ switch (ref->u.ar.type) *************** gfc_array_allocate (gfc_se * se, gfc_exp *** 3713,3726 **** /* The allocate_array variants take the old pointer as first argument. */ if (allocatable_array) ! tmp = gfc_allocate_array_with_status (&se->pre, pointer, size, pstat); else tmp = gfc_allocate_with_status (&se->pre, size, pstat); ! tmp = build2 (MODIFY_EXPR, void_type_node, pointer, tmp); gfc_add_expr_to_block (&se->pre, tmp); tmp = gfc_conv_descriptor_offset (se->expr); ! gfc_add_modify_expr (&se->pre, tmp, offset); if (expr->ts.type == BT_DERIVED && expr->ts.derived->attr.alloc_comp) --- 3848,3861 ---- /* The allocate_array variants take the old pointer as first argument. */ if (allocatable_array) ! tmp = gfc_allocate_array_with_status (&se->pre, pointer, size, pstat, expr); else tmp = gfc_allocate_with_status (&se->pre, size, pstat); ! tmp = fold_build2 (MODIFY_EXPR, void_type_node, pointer, tmp); gfc_add_expr_to_block (&se->pre, tmp); tmp = gfc_conv_descriptor_offset (se->expr); ! gfc_add_modify (&se->pre, tmp, offset); if (expr->ts.type == BT_DERIVED && expr->ts.derived->attr.alloc_comp) *************** gfc_array_allocate (gfc_se * se, gfc_exp *** 3739,3745 **** /*GCC ARRAYS*/ tree ! gfc_array_deallocate (tree descriptor, tree pstat) { tree var; tree tmp; --- 3874,3880 ---- /*GCC ARRAYS*/ tree ! gfc_array_deallocate (tree descriptor, tree pstat, gfc_expr* expr) { tree var; tree tmp; *************** gfc_array_deallocate (tree descriptor, t *** 3751,3762 **** STRIP_NOPS (var); /* Parameter is the address of the data component. */ ! tmp = gfc_deallocate_with_status (var, pstat, false); gfc_add_expr_to_block (&block, tmp); /* Zero the data pointer. */ ! tmp = build2 (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); --- 3886,3897 ---- STRIP_NOPS (var); /* Parameter is the address of the data component. */ ! tmp = gfc_deallocate_with_status (var, pstat, false, expr); gfc_add_expr_to_block (&block, tmp); /* Zero the data pointer. */ ! tmp = fold_build2 (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); *************** gfc_conv_array_initializer (tree type, g *** 3815,3824 **** if (c->iterator) { /* Problems occur when we get something like ! integer :: a(lots) = (/(i, i=1,lots)/) */ ! /* TODO: Unexpanded array initializers. */ ! internal_error ! ("Possible frontend bug: array constructor not expanded"); } if (mpz_cmp_si (c->n.offset, 0) != 0) index = gfc_conv_mpz_to_tree (c->n.offset, gfc_index_integer_kind); --- 3950,3962 ---- if (c->iterator) { /* Problems occur when we get something like ! integer :: a(lots) = (/(i, i=1, lots)/) */ ! gfc_error_now ("The number of elements in the array constructor " ! "at %L requires an increase of the allowed %d " ! "upper limit. See -fmax-array-constructor " ! "option", &expr->where, ! gfc_option.flag_max_array_constructor); ! return NULL_TREE; } if (mpz_cmp_si (c->n.offset, 0) != 0) index = gfc_conv_mpz_to_tree (c->n.offset, gfc_index_integer_kind); *************** gfc_conv_array_initializer (tree type, g *** 3841,3847 **** else tmp1 = gfc_conv_mpz_to_tree (c->n.offset, gfc_index_integer_kind); ! range = build2 (RANGE_EXPR, integer_type_node, tmp1, tmp2); } else range = NULL; --- 3979,3985 ---- else tmp1 = gfc_conv_mpz_to_tree (c->n.offset, gfc_index_integer_kind); ! range = fold_build2 (RANGE_EXPR, integer_type_node, tmp1, tmp2); } else range = NULL; *************** gfc_conv_array_initializer (tree type, g *** 3867,3874 **** CONSTRUCTOR_APPEND_ELT (v, index, se.expr); break; default: ! gcc_unreachable (); } } break; --- 4005,4025 ---- CONSTRUCTOR_APPEND_ELT (v, index, se.expr); break; + default: ! /* Catch those occasional beasts that do not simplify ! for one reason or another, assuming that if they are ! standard defying the frontend will catch them. */ ! gfc_conv_expr (&se, c->expr); ! if (range == NULL_TREE) ! CONSTRUCTOR_APPEND_ELT (v, index, se.expr); ! else ! { ! if (index != NULL_TREE) ! CONSTRUCTOR_APPEND_ELT (v, index, se.expr); ! CONSTRUCTOR_APPEND_ELT (v, range, se.expr); ! } ! break; } } break; *************** gfc_conv_array_initializer (tree type, g *** 3883,3889 **** /* Create a constructor from the list of elements. */ tmp = build_constructor (type, v); TREE_CONSTANT (tmp) = 1; - TREE_INVARIANT (tmp) = 1; return tmp; } --- 4034,4039 ---- *************** gfc_trans_array_bounds (tree type, gfc_s *** 3919,3925 **** gfc_init_se (&se, NULL); gfc_conv_expr_type (&se, as->lower[dim], gfc_array_index_type); gfc_add_block_to_block (pblock, &se.pre); ! gfc_add_modify_expr (pblock, lbound, se.expr); } ubound = GFC_TYPE_ARRAY_UBOUND (type, dim); if (as->upper[dim] && !INTEGER_CST_P (ubound)) --- 4069,4075 ---- gfc_init_se (&se, NULL); gfc_conv_expr_type (&se, as->lower[dim], gfc_array_index_type); gfc_add_block_to_block (pblock, &se.pre); ! gfc_add_modify (pblock, lbound, se.expr); } ubound = GFC_TYPE_ARRAY_UBOUND (type, dim); if (as->upper[dim] && !INTEGER_CST_P (ubound)) *************** gfc_trans_array_bounds (tree type, gfc_s *** 3927,3933 **** gfc_init_se (&se, NULL); gfc_conv_expr_type (&se, as->upper[dim], gfc_array_index_type); gfc_add_block_to_block (pblock, &se.pre); ! gfc_add_modify_expr (pblock, ubound, se.expr); } /* The offset of this dimension. offset = offset - lbound * stride. */ tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, lbound, size); --- 4077,4083 ---- gfc_init_se (&se, NULL); gfc_conv_expr_type (&se, as->upper[dim], gfc_array_index_type); gfc_add_block_to_block (pblock, &se.pre); ! gfc_add_modify (pblock, ubound, se.expr); } /* The offset of this dimension. offset = offset - lbound * stride. */ tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, lbound, size); *************** gfc_trans_array_bounds (tree type, gfc_s *** 3947,3963 **** tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ubound, tmp); tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, size, tmp); if (stride) ! gfc_add_modify_expr (pblock, stride, tmp); else stride = gfc_evaluate_now (tmp, pblock); /* Make sure that negative size arrays are translated to being zero size. */ ! tmp = build2 (GE_EXPR, boolean_type_node, ! stride, gfc_index_zero_node); ! tmp = build3 (COND_EXPR, gfc_array_index_type, tmp, ! stride, gfc_index_zero_node); ! gfc_add_modify_expr (pblock, stride, tmp); } size = stride; --- 4097,4113 ---- tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ubound, tmp); tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, size, tmp); if (stride) ! gfc_add_modify (pblock, stride, tmp); else stride = gfc_evaluate_now (tmp, pblock); /* Make sure that negative size arrays are translated to being zero size. */ ! tmp = fold_build2 (GE_EXPR, boolean_type_node, ! stride, gfc_index_zero_node); ! tmp = fold_build3 (COND_EXPR, gfc_array_index_type, tmp, ! stride, gfc_index_zero_node); ! gfc_add_modify (pblock, stride, tmp); } size = stride; *************** gfc_trans_auto_array_allocation (tree de *** 3998,4010 **** if (sym->ts.type == BT_CHARACTER && onstack && !INTEGER_CST_P (sym->ts.cl->backend_decl)) { ! gfc_conv_string_length (sym->ts.cl, &block); gfc_trans_vla_type_sizes (sym, &block); /* Emit a DECL_EXPR for this variable, which will cause the gimplifier to allocate storage, and all that good stuff. */ ! tmp = build1 (DECL_EXPR, TREE_TYPE (decl), decl); gfc_add_expr_to_block (&block, tmp); } --- 4148,4160 ---- if (sym->ts.type == BT_CHARACTER && onstack && !INTEGER_CST_P (sym->ts.cl->backend_decl)) { ! gfc_conv_string_length (sym->ts.cl, NULL, &block); gfc_trans_vla_type_sizes (sym, &block); /* Emit a DECL_EXPR for this variable, which will cause the gimplifier to allocate storage, and all that good stuff. */ ! tmp = fold_build1 (DECL_EXPR, TREE_TYPE (decl), decl); gfc_add_expr_to_block (&block, tmp); } *************** gfc_trans_auto_array_allocation (tree de *** 4022,4028 **** if (sym->ts.type == BT_CHARACTER && !INTEGER_CST_P (sym->ts.cl->backend_decl)) ! gfc_conv_string_length (sym->ts.cl, &block); size = gfc_trans_array_bounds (type, sym, &offset, &block); --- 4172,4178 ---- if (sym->ts.type == BT_CHARACTER && !INTEGER_CST_P (sym->ts.cl->backend_decl)) ! gfc_conv_string_length (sym->ts.cl, NULL, &block); size = gfc_trans_array_bounds (type, sym, &offset, &block); *************** gfc_trans_auto_array_allocation (tree de *** 4030,4036 **** if (sym->attr.cray_pointee) { if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL) ! gfc_add_modify_expr (&block, GFC_TYPE_ARRAY_OFFSET (type), offset); gfc_add_expr_to_block (&block, fnbody); return gfc_finish_block (&block); } --- 4180,4186 ---- if (sym->attr.cray_pointee) { if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL) ! gfc_add_modify (&block, GFC_TYPE_ARRAY_OFFSET (type), offset); gfc_add_expr_to_block (&block, fnbody); return gfc_finish_block (&block); } *************** gfc_trans_auto_array_allocation (tree de *** 4043,4053 **** /* Allocate memory to hold the data. */ tmp = gfc_call_malloc (&block, TREE_TYPE (decl), size); ! gfc_add_modify_expr (&block, decl, tmp); /* Set offset of the array. */ if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL) ! gfc_add_modify_expr (&block, GFC_TYPE_ARRAY_OFFSET (type), offset); /* Automatic arrays should not have initializers. */ --- 4193,4203 ---- /* Allocate memory to hold the data. */ tmp = gfc_call_malloc (&block, TREE_TYPE (decl), size); ! gfc_add_modify (&block, decl, tmp); /* Set offset of the array. */ if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL) ! gfc_add_modify (&block, GFC_TYPE_ARRAY_OFFSET (type), offset); /* Automatic arrays should not have initializers. */ *************** gfc_trans_g77_array (gfc_symbol * sym, t *** 4088,4107 **** if (sym->ts.type == BT_CHARACTER && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL) ! gfc_conv_string_length (sym->ts.cl, &block); /* Evaluate the bounds of the array. */ gfc_trans_array_bounds (type, sym, &offset, &block); /* Set the offset. */ if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL) ! gfc_add_modify_expr (&block, GFC_TYPE_ARRAY_OFFSET (type), offset); /* Set the pointer itself if we aren't using the parameter directly. */ if (TREE_CODE (parm) != PARM_DECL) { tmp = convert (TREE_TYPE (parm), GFC_DECL_SAVED_DESCRIPTOR (parm)); ! gfc_add_modify_expr (&block, parm, tmp); } stmt = gfc_finish_block (&block); --- 4238,4257 ---- if (sym->ts.type == BT_CHARACTER && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL) ! gfc_conv_string_length (sym->ts.cl, NULL, &block); /* Evaluate the bounds of the array. */ gfc_trans_array_bounds (type, sym, &offset, &block); /* Set the offset. */ if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL) ! gfc_add_modify (&block, GFC_TYPE_ARRAY_OFFSET (type), offset); /* Set the pointer itself if we aren't using the parameter directly. */ if (TREE_CODE (parm) != PARM_DECL) { tmp = convert (TREE_TYPE (parm), GFC_DECL_SAVED_DESCRIPTOR (parm)); ! gfc_add_modify (&block, parm, tmp); } stmt = gfc_finish_block (&block); *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 4180,4186 **** if (sym->ts.type == BT_CHARACTER && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL) ! gfc_conv_string_length (sym->ts.cl, &block); checkparm = (sym->as->type == AS_EXPLICIT && flag_bounds_check); --- 4330,4336 ---- if (sym->ts.type == BT_CHARACTER && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL) ! gfc_conv_string_length (sym->ts.cl, NULL, &block); checkparm = (sym->as->type == AS_EXPLICIT && flag_bounds_check); *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 4196,4202 **** TREE_USED (partial) = 1; tmp = gfc_conv_descriptor_stride (dumdesc, gfc_rank_cst[0]); tmp = fold_build2 (EQ_EXPR, boolean_type_node, tmp, gfc_index_one_node); ! gfc_add_modify_expr (&block, partial, tmp); } else { --- 4346,4352 ---- TREE_USED (partial) = 1; tmp = gfc_conv_descriptor_stride (dumdesc, gfc_rank_cst[0]); tmp = fold_build2 (EQ_EXPR, boolean_type_node, tmp, gfc_index_one_node); ! gfc_add_modify (&block, partial, tmp); } else { *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 4211,4221 **** stride = gfc_conv_descriptor_stride (dumdesc, gfc_rank_cst[0]); stride = gfc_evaluate_now (stride, &block); ! tmp = build2 (EQ_EXPR, boolean_type_node, stride, gfc_index_zero_node); ! tmp = build3 (COND_EXPR, gfc_array_index_type, tmp, ! gfc_index_one_node, stride); stride = GFC_TYPE_ARRAY_STRIDE (type, 0); ! gfc_add_modify_expr (&block, stride, tmp); /* Allow the user to disable array repacking. */ stmt_unpacked = NULL_TREE; --- 4361,4372 ---- stride = gfc_conv_descriptor_stride (dumdesc, gfc_rank_cst[0]); stride = gfc_evaluate_now (stride, &block); ! tmp = fold_build2 (EQ_EXPR, boolean_type_node, ! stride, gfc_index_zero_node); ! tmp = fold_build3 (COND_EXPR, gfc_array_index_type, tmp, ! gfc_index_one_node, stride); stride = GFC_TYPE_ARRAY_STRIDE (type, 0); ! gfc_add_modify (&block, stride, tmp); /* Allow the user to disable array repacking. */ stmt_unpacked = NULL_TREE; *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 4228,4233 **** --- 4379,4387 ---- stmt_unpacked = build_call_expr (gfor_fndecl_in_pack, 1, tmp); stride = gfc_index_one_node; + + if (gfc_option.warn_array_temp) + gfc_warning ("Creating array temporary at %L", &loc); } /* This is for the case where the array data is used directly without *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 4241,4252 **** if (stmt_packed != NULL_TREE && stmt_unpacked != NULL_TREE) { /* Don't repack unknown shape arrays when the first stride is 1. */ ! tmp = build3 (COND_EXPR, TREE_TYPE (stmt_packed), partial, ! stmt_packed, stmt_unpacked); } else tmp = stmt_packed != NULL_TREE ? stmt_packed : stmt_unpacked; ! gfc_add_modify_expr (&block, tmpdesc, fold_convert (type, tmp)); offset = gfc_index_zero_node; size = gfc_index_one_node; --- 4395,4406 ---- if (stmt_packed != NULL_TREE && stmt_unpacked != NULL_TREE) { /* Don't repack unknown shape arrays when the first stride is 1. */ ! tmp = fold_build3 (COND_EXPR, TREE_TYPE (stmt_packed), ! partial, stmt_packed, stmt_unpacked); } else tmp = stmt_packed != NULL_TREE ? stmt_packed : stmt_unpacked; ! gfc_add_modify (&block, tmpdesc, fold_convert (type, tmp)); offset = gfc_index_zero_node; size = gfc_index_one_node; *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 4273,4279 **** gfc_conv_expr_type (&se, sym->as->lower[n], gfc_array_index_type); gfc_add_block_to_block (&block, &se.pre); ! gfc_add_modify_expr (&block, lbound, se.expr); } ubound = GFC_TYPE_ARRAY_UBOUND (type, n); --- 4427,4433 ---- gfc_conv_expr_type (&se, sym->as->lower[n], gfc_array_index_type); gfc_add_block_to_block (&block, &se.pre); ! gfc_add_modify (&block, lbound, se.expr); } ubound = GFC_TYPE_ARRAY_UBOUND (type, n); *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 4287,4293 **** gfc_conv_expr_type (&se, sym->as->upper[n], gfc_array_index_type); gfc_add_block_to_block (&block, &se.pre); ! gfc_add_modify_expr (&block, ubound, se.expr); } /* Check the sizes match. */ --- 4441,4447 ---- gfc_conv_expr_type (&se, sym->as->upper[n], gfc_array_index_type); gfc_add_block_to_block (&block, &se.pre); ! gfc_add_modify (&block, ubound, se.expr); } /* Check the sizes match. */ *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 4298,4309 **** tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, ubound, lbound); ! stride2 = build2 (MINUS_EXPR, gfc_array_index_type, ! dubound, dlbound); tmp = fold_build2 (NE_EXPR, gfc_array_index_type, tmp, stride2); asprintf (&msg, "%s for dimension %d of array '%s'", gfc_msg_bounds, n+1, sym->name); ! gfc_trans_runtime_check (tmp, &block, &loc, msg); gfc_free (msg); } } --- 4452,4463 ---- tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, ubound, lbound); ! stride2 = fold_build2 (MINUS_EXPR, gfc_array_index_type, ! dubound, dlbound); tmp = fold_build2 (NE_EXPR, gfc_array_index_type, tmp, stride2); asprintf (&msg, "%s for dimension %d of array '%s'", gfc_msg_bounds, n+1, sym->name); ! gfc_trans_runtime_check (true, false, tmp, &block, &loc, msg); gfc_free (msg); } } *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 4311,4319 **** { /* For assumed shape arrays move the upper bound by the same amount as the lower bound. */ ! tmp = build2 (MINUS_EXPR, gfc_array_index_type, dubound, dlbound); tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp, lbound); ! gfc_add_modify_expr (&block, ubound, tmp); } /* The offset of this dimension. offset = offset - lbound * stride. */ tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, lbound, stride); --- 4465,4474 ---- { /* For assumed shape arrays move the upper bound by the same amount as the lower bound. */ ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, ! dubound, dlbound); tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp, lbound); ! gfc_add_modify (&block, ubound, tmp); } /* The offset of this dimension. offset = offset - lbound * stride. */ tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, lbound, stride); *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 4349,4359 **** /* Assign the stride. */ if (stmt_packed != NULL_TREE && stmt_unpacked != NULL_TREE) ! tmp = build3 (COND_EXPR, gfc_array_index_type, partial, ! stmt_unpacked, stmt_packed); else tmp = (stmt_packed != NULL_TREE) ? stmt_packed : stmt_unpacked; ! gfc_add_modify_expr (&block, stride, tmp); } } else --- 4504,4514 ---- /* Assign the stride. */ if (stmt_packed != NULL_TREE && stmt_unpacked != NULL_TREE) ! tmp = fold_build3 (COND_EXPR, gfc_array_index_type, partial, ! stmt_unpacked, stmt_packed); else tmp = (stmt_packed != NULL_TREE) ? stmt_packed : stmt_unpacked; ! gfc_add_modify (&block, stride, tmp); } } else *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 4369,4382 **** ubound, tmp); tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, GFC_TYPE_ARRAY_STRIDE (type, n), tmp); ! gfc_add_modify_expr (&block, stride, tmp); } } } /* Set the offset. */ if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL) ! gfc_add_modify_expr (&block, GFC_TYPE_ARRAY_OFFSET (type), offset); gfc_trans_vla_type_sizes (sym, &block); --- 4524,4537 ---- ubound, tmp); tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, GFC_TYPE_ARRAY_STRIDE (type, n), tmp); ! gfc_add_modify (&block, stride, tmp); } } } /* Set the offset. */ if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL) ! gfc_add_modify (&block, GFC_TYPE_ARRAY_OFFSET (type), offset); gfc_trans_vla_type_sizes (sym, &block); *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 4420,4426 **** /* Only do the cleanup if the array was repacked. */ tmp = build_fold_indirect_ref (dumdesc); tmp = gfc_conv_descriptor_data_get (tmp); ! tmp = build2 (NE_EXPR, boolean_type_node, tmp, tmpdesc); stmt = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt ()); if (optional_arg) --- 4575,4581 ---- /* Only do the cleanup if the array was repacked. */ tmp = build_fold_indirect_ref (dumdesc); tmp = gfc_conv_descriptor_data_get (tmp); ! tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp, tmpdesc); stmt = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt ()); if (optional_arg) *************** gfc_get_dataptr_offset (stmtblock_t *blo *** 4464,4470 **** tmp = gfc_build_array_ref (tmp, offset, NULL); /* Offset the data pointer for pointer assignments from arrays with ! subreferences; eg. my_integer => my_type(:)%integer_component. */ if (subref) { /* Go past the array reference. */ --- 4619,4625 ---- tmp = gfc_build_array_ref (tmp, offset, NULL); /* Offset the data pointer for pointer assignments from arrays with ! subreferences; e.g. my_integer => my_type(:)%integer_component. */ if (subref) { /* Go past the array reference. */ *************** gfc_get_dataptr_offset (stmtblock_t *blo *** 4484,4490 **** case REF_COMPONENT: field = ref->u.c.component->backend_decl; gcc_assert (field && TREE_CODE (field) == FIELD_DECL); ! tmp = build3 (COMPONENT_REF, TREE_TYPE (field), tmp, field, NULL_TREE); break; case REF_SUBSTRING: --- 4639,4646 ---- case REF_COMPONENT: field = ref->u.c.component->backend_decl; gcc_assert (field && TREE_CODE (field) == FIELD_DECL); ! tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field), ! tmp, field, NULL_TREE); break; case REF_SUBSTRING: *************** get_elemental_fcn_charlen (gfc_expr *exp *** 4562,4568 **** arg = expr->value.function.actual; gfc_init_interface_mapping (&mapping); ! /* Set se = NULL in the calls to the interface mapping, to supress any backend stuff. */ for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL) { --- 4718,4724 ---- arg = expr->value.function.actual; gfc_init_interface_mapping (&mapping); ! /* Set se = NULL in the calls to the interface mapping, to suppress any backend stuff. */ for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL) { *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 4670,4676 **** if (se->direct_byref) { /* Copy the descriptor for pointer assignments. */ ! gfc_add_modify_expr (&se->pre, se->expr, desc); /* Add any offsets from subreferences. */ gfc_get_dataptr_offset (&se->pre, se->expr, desc, NULL_TREE, --- 4826,4832 ---- if (se->direct_byref) { /* Copy the descriptor for pointer assignments. */ ! gfc_add_modify (&se->pre, se->expr, desc); /* Add any offsets from subreferences. */ gfc_get_dataptr_offset (&se->pre, se->expr, desc, NULL_TREE, *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 4760,4766 **** break; } - gfc_init_loopinfo (&loop); /* Associate the SS with the loop. */ --- 4916,4921 ---- *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 4784,4790 **** loop.temp_ss->next = gfc_ss_terminator; if (expr->ts.type == BT_CHARACTER && !expr->ts.cl->backend_decl) ! gfc_conv_string_length (expr->ts.cl, &se->pre); loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts); --- 4939,4945 ---- loop.temp_ss->next = gfc_ss_terminator; if (expr->ts.type == BT_CHARACTER && !expr->ts.cl->backend_decl) ! gfc_conv_string_length (expr->ts.cl, expr, &se->pre); loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts); *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 4798,4804 **** gfc_add_ss_to_loop (&loop, loop.temp_ss); } ! gfc_conv_loop_setup (&loop); if (need_tmp) { --- 4953,4959 ---- gfc_add_ss_to_loop (&loop, loop.temp_ss); } ! gfc_conv_loop_setup (&loop, & expr->where); if (need_tmp) { *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 4903,4909 **** /* Set the dtype. */ tmp = gfc_conv_descriptor_dtype (parm); ! gfc_add_modify_expr (&loop.pre, tmp, gfc_get_dtype (parmtype)); /* Set offset for assignments to pointer only to zero if it is not the full array. */ --- 5058,5064 ---- /* Set the dtype. */ tmp = gfc_conv_descriptor_dtype (parm); ! gfc_add_modify (&loop.pre, tmp, gfc_get_dtype (parmtype)); /* Set offset for assignments to pointer only to zero if it is not the full array. */ *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 4972,4982 **** from = gfc_index_one_node; } tmp = gfc_conv_descriptor_lbound (parm, gfc_rank_cst[dim]); ! gfc_add_modify_expr (&loop.pre, tmp, from); /* Set the new upper bound. */ tmp = gfc_conv_descriptor_ubound (parm, gfc_rank_cst[dim]); ! gfc_add_modify_expr (&loop.pre, tmp, to); /* Multiply the stride by the section stride to get the total stride. */ --- 5127,5137 ---- from = gfc_index_one_node; } tmp = gfc_conv_descriptor_lbound (parm, gfc_rank_cst[dim]); ! gfc_add_modify (&loop.pre, tmp, from); /* Set the new upper bound. */ tmp = gfc_conv_descriptor_ubound (parm, gfc_rank_cst[dim]); ! gfc_add_modify (&loop.pre, tmp, to); /* Multiply the stride by the section stride to get the total stride. */ *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 5001,5007 **** /* Store the new stride. */ tmp = gfc_conv_descriptor_stride (parm, gfc_rank_cst[dim]); ! gfc_add_modify_expr (&loop.pre, tmp, stride); dim++; } --- 5156,5162 ---- /* Store the new stride. */ tmp = gfc_conv_descriptor_stride (parm, gfc_rank_cst[dim]); ! gfc_add_modify (&loop.pre, tmp, stride); dim++; } *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 5018,5031 **** { /* Set the offset. */ tmp = gfc_conv_descriptor_offset (parm); ! gfc_add_modify_expr (&loop.pre, tmp, base); } else { /* Only the callee knows what the correct offset it, so just set it to zero here. */ tmp = gfc_conv_descriptor_offset (parm); ! gfc_add_modify_expr (&loop.pre, tmp, gfc_index_zero_node); } desc = parm; } --- 5173,5186 ---- { /* Set the offset. */ tmp = gfc_conv_descriptor_offset (parm); ! gfc_add_modify (&loop.pre, tmp, base); } else { /* Only the callee knows what the correct offset it, so just set it to zero here. */ tmp = gfc_conv_descriptor_offset (parm); ! gfc_add_modify (&loop.pre, tmp, gfc_index_zero_node); } desc = parm; } *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 5052,5058 **** void gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77, ! const gfc_symbol *fsym) { tree ptr; tree desc; --- 5207,5213 ---- void gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77, ! const gfc_symbol *fsym, const char *proc_name) { tree ptr; tree desc; *************** gfc_conv_array_parameter (gfc_se * se, g *** 5064,5072 **** stmtblock_t block; full_array_var = (expr->expr_type == EXPR_VARIABLE ! && expr->ref->u.ar.type == AR_FULL); sym = full_array_var ? expr->symtree->n.sym : NULL; if (expr->expr_type == EXPR_ARRAY && expr->ts.type == BT_CHARACTER) { get_array_ctor_strlen (&se->pre, expr->value.constructor, &tmp); --- 5219,5231 ---- stmtblock_t block; full_array_var = (expr->expr_type == EXPR_VARIABLE ! && expr->ref->type == REF_ARRAY ! && expr->ref->u.ar.type == AR_FULL); sym = full_array_var ? expr->symtree->n.sym : NULL; + /* The symbol should have an array specification. */ + gcc_assert (!sym || sym->as); + if (expr->expr_type == EXPR_ARRAY && expr->ts.type == BT_CHARACTER) { get_array_ctor_strlen (&se->pre, expr->value.constructor, &tmp); *************** gfc_conv_array_parameter (gfc_se * se, g *** 5146,5168 **** { desc = se->expr; /* Repack the array. */ ptr = build_call_expr (gfor_fndecl_in_pack, 1, desc); if (fsym && fsym->attr.optional && sym && sym->attr.optional) { tmp = gfc_conv_expr_present (sym); ! ptr = build3 (COND_EXPR, TREE_TYPE (se->expr), tmp, ptr, ! null_pointer_node); } ptr = gfc_evaluate_now (ptr, &se->pre); se->expr = ptr; gfc_start_block (&block); /* Copy the data back. */ ! tmp = build_call_expr (gfor_fndecl_in_unpack, 2, desc, ptr); ! gfc_add_expr_to_block (&block, tmp); /* Free the temporary. */ tmp = gfc_call_free (convert (pvoid_type_node, ptr)); --- 5305,5366 ---- { desc = se->expr; /* Repack the array. */ + + if (gfc_option.warn_array_temp) + { + if (fsym) + gfc_warning ("Creating array temporary at %L for argument '%s'", + &expr->where, fsym->name); + else + gfc_warning ("Creating array temporary at %L", &expr->where); + } + ptr = build_call_expr (gfor_fndecl_in_pack, 1, desc); if (fsym && fsym->attr.optional && sym && sym->attr.optional) { tmp = gfc_conv_expr_present (sym); ! ptr = build3 (COND_EXPR, TREE_TYPE (se->expr), tmp, ! fold_convert (TREE_TYPE (se->expr), ptr), ! fold_convert (TREE_TYPE (se->expr), null_pointer_node)); } ptr = gfc_evaluate_now (ptr, &se->pre); + se->expr = ptr; + if (gfc_option.flag_check_array_temporaries) + { + char * msg; + + if (fsym && proc_name) + asprintf (&msg, "An array temporary was created for argument " + "'%s' of procedure '%s'", fsym->name, proc_name); + else + asprintf (&msg, "An array temporary was created"); + + tmp = build_fold_indirect_ref (desc); + tmp = gfc_conv_array_data (tmp); + tmp = fold_build2 (NE_EXPR, boolean_type_node, + fold_convert (TREE_TYPE (tmp), ptr), tmp); + + if (fsym && fsym->attr.optional && sym && sym->attr.optional) + tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, + gfc_conv_expr_present (sym), tmp); + + gfc_trans_runtime_check (false, true, tmp, &se->pre, + &expr->where, msg); + gfc_free (msg); + } + gfc_start_block (&block); /* Copy the data back. */ ! if (fsym == NULL || fsym->attr.intent != INTENT_IN) ! { ! tmp = build_call_expr (gfor_fndecl_in_unpack, 2, desc, ptr); ! gfc_add_expr_to_block (&block, tmp); ! } /* Free the temporary. */ tmp = gfc_call_free (convert (pvoid_type_node, ptr)); *************** gfc_conv_array_parameter (gfc_se * se, g *** 5175,5182 **** loop cleanup code. */ tmp = build_fold_indirect_ref (desc); tmp = gfc_conv_array_data (tmp); ! tmp = build2 (NE_EXPR, boolean_type_node, ! fold_convert (TREE_TYPE (tmp), ptr), tmp); if (fsym && fsym->attr.optional && sym && sym->attr.optional) tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, --- 5373,5380 ---- loop cleanup code. */ tmp = build_fold_indirect_ref (desc); tmp = gfc_conv_array_data (tmp); ! tmp = fold_build2 (NE_EXPR, boolean_type_node, ! fold_convert (TREE_TYPE (tmp), ptr), tmp); if (fsym && fsym->attr.optional && sym && sym->attr.optional) tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, *************** gfc_trans_dealloc_allocated (tree descri *** 5210,5221 **** /* 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 (var, NULL_TREE, true); gfc_add_expr_to_block (&block, tmp); /* Zero the data pointer. */ ! tmp = build2 (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); --- 5408,5419 ---- /* 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 (var, NULL_TREE, true, NULL); gfc_add_expr_to_block (&block, tmp); /* Zero the data pointer. */ ! tmp = fold_build2 (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); *************** get_full_array_size (stmtblock_t *block, *** 5233,5245 **** idx = gfc_rank_cst[rank - 1]; nelems = gfc_conv_descriptor_ubound (decl, idx); tmp = gfc_conv_descriptor_lbound (decl, idx); ! tmp = build2 (MINUS_EXPR, gfc_array_index_type, nelems, tmp); ! tmp = build2 (PLUS_EXPR, gfc_array_index_type, ! tmp, gfc_index_one_node); tmp = gfc_evaluate_now (tmp, block); nelems = gfc_conv_descriptor_stride (decl, idx); ! tmp = build2 (MULT_EXPR, gfc_array_index_type, nelems, tmp); return gfc_evaluate_now (tmp, block); } --- 5431,5443 ---- idx = gfc_rank_cst[rank - 1]; nelems = gfc_conv_descriptor_ubound (decl, idx); tmp = gfc_conv_descriptor_lbound (decl, idx); ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, nelems, tmp); ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! tmp, gfc_index_one_node); tmp = gfc_evaluate_now (tmp, block); nelems = gfc_conv_descriptor_stride (decl, idx); ! tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, nelems, tmp); return gfc_evaluate_now (tmp, block); } *************** gfc_duplicate_allocatable(tree dest, tre *** 5285,5292 **** the allocate and copy. */ null_cond = gfc_conv_descriptor_data_get (src); null_cond = convert (pvoid_type_node, null_cond); ! null_cond = build2 (NE_EXPR, boolean_type_node, null_cond, ! null_pointer_node); return build3_v (COND_EXPR, null_cond, tmp, null_data); } --- 5483,5490 ---- the allocate and copy. */ null_cond = gfc_conv_descriptor_data_get (src); null_cond = convert (pvoid_type_node, null_cond); ! null_cond = fold_build2 (NE_EXPR, boolean_type_node, ! null_cond, null_pointer_node); return build3_v (COND_EXPR, null_cond, tmp, null_data); } *************** structure_alloc_comps (gfc_symbol * der_ *** 5336,5347 **** is a full array reference, we only need the descriptor information from dimension = rank. */ tmp = get_full_array_size (&fnblock, decl, rank); ! tmp = build2 (MINUS_EXPR, gfc_array_index_type, ! tmp, gfc_index_one_node); null_cond = gfc_conv_descriptor_data_get (decl); ! null_cond = build2 (NE_EXPR, boolean_type_node, null_cond, ! build_int_cst (TREE_TYPE (null_cond), 0)); } else { --- 5534,5545 ---- is a full array reference, we only need the descriptor information from dimension = rank. */ tmp = get_full_array_size (&fnblock, decl, rank); ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, ! tmp, gfc_index_one_node); null_cond = gfc_conv_descriptor_data_get (decl); ! null_cond = fold_build2 (NE_EXPR, boolean_type_node, null_cond, ! build_int_cst (TREE_TYPE (null_cond), 0)); } else { *************** structure_alloc_comps (gfc_symbol * der_ *** 5405,5438 **** case DEALLOCATE_ALLOC_COMP: /* Do not deallocate the components of ultimate pointer components. */ ! if (cmp_has_alloc_comps && !c->pointer) { ! comp = build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); rank = c->as ? c->as->rank : 0; tmp = structure_alloc_comps (c->ts.derived, comp, NULL_TREE, rank, purpose); gfc_add_expr_to_block (&fnblock, tmp); } ! if (c->allocatable) { ! comp = build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); tmp = gfc_trans_dealloc_allocated (comp); gfc_add_expr_to_block (&fnblock, tmp); } break; case NULLIFY_ALLOC_COMP: ! if (c->pointer) continue; ! else if (c->allocatable) { ! comp = build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node); } else if (cmp_has_alloc_comps) { ! comp = build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); rank = c->as ? c->as->rank : 0; tmp = structure_alloc_comps (c->ts.derived, comp, NULL_TREE, rank, purpose); --- 5603,5640 ---- case DEALLOCATE_ALLOC_COMP: /* Do not deallocate the components of ultimate pointer components. */ ! if (cmp_has_alloc_comps && !c->attr.pointer) { ! comp = fold_build3 (COMPONENT_REF, ctype, ! decl, cdecl, NULL_TREE); rank = c->as ? c->as->rank : 0; tmp = structure_alloc_comps (c->ts.derived, comp, NULL_TREE, rank, purpose); gfc_add_expr_to_block (&fnblock, tmp); } ! if (c->attr.allocatable) { ! comp = fold_build3 (COMPONENT_REF, ctype, ! decl, cdecl, NULL_TREE); tmp = gfc_trans_dealloc_allocated (comp); gfc_add_expr_to_block (&fnblock, tmp); } break; case NULLIFY_ALLOC_COMP: ! if (c->attr.pointer) continue; ! else if (c->attr.allocatable) { ! comp = fold_build3 (COMPONENT_REF, ctype, ! decl, cdecl, NULL_TREE); gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node); } else if (cmp_has_alloc_comps) { ! comp = fold_build3 (COMPONENT_REF, ctype, ! decl, cdecl, NULL_TREE); rank = c->as ? c->as->rank : 0; tmp = structure_alloc_comps (c->ts.derived, comp, NULL_TREE, rank, purpose); *************** structure_alloc_comps (gfc_symbol * der_ *** 5441,5455 **** break; case COPY_ALLOC_COMP: ! if (c->pointer) continue; /* We need source and destination components. */ ! comp = build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); ! dcmp = build3 (COMPONENT_REF, ctype, dest, cdecl, NULL_TREE); dcmp = fold_convert (TREE_TYPE (comp), dcmp); ! if (c->allocatable && !cmp_has_alloc_comps) { tmp = gfc_duplicate_allocatable(dcmp, comp, ctype, c->as->rank); gfc_add_expr_to_block (&fnblock, tmp); --- 5643,5657 ---- break; case COPY_ALLOC_COMP: ! if (c->attr.pointer) continue; /* We need source and destination components. */ ! comp = fold_build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); ! dcmp = fold_build3 (COMPONENT_REF, ctype, dest, cdecl, NULL_TREE); dcmp = fold_convert (TREE_TYPE (comp), dcmp); ! if (c->attr.allocatable && !cmp_has_alloc_comps) { tmp = gfc_duplicate_allocatable(dcmp, comp, ctype, c->as->rank); gfc_add_expr_to_block (&fnblock, tmp); *************** structure_alloc_comps (gfc_symbol * der_ *** 5459,5465 **** { rank = c->as ? c->as->rank : 0; tmp = fold_convert (TREE_TYPE (dcmp), comp); ! gfc_add_modify_expr (&fnblock, dcmp, tmp); tmp = structure_alloc_comps (c->ts.derived, comp, dcmp, rank, purpose); gfc_add_expr_to_block (&fnblock, tmp); --- 5661,5667 ---- { rank = c->as ? c->as->rank : 0; tmp = fold_convert (TREE_TYPE (dcmp), comp); ! gfc_add_modify (&fnblock, dcmp, tmp); tmp = structure_alloc_comps (c->ts.derived, comp, dcmp, rank, purpose); gfc_add_expr_to_block (&fnblock, tmp); *************** gfc_trans_deferred_array (gfc_symbol * s *** 5539,5545 **** if (sym->ts.type == BT_CHARACTER && !INTEGER_CST_P (sym->ts.cl->backend_decl)) { ! gfc_conv_string_length (sym->ts.cl, &fnblock); gfc_trans_vla_type_sizes (sym, &fnblock); } --- 5741,5747 ---- if (sym->ts.type == BT_CHARACTER && !INTEGER_CST_P (sym->ts.cl->backend_decl)) { ! gfc_conv_string_length (sym->ts.cl, NULL, &fnblock); gfc_trans_vla_type_sizes (sym, &fnblock); } *************** gfc_walk_op_expr (gfc_ss * ss, gfc_expr *** 5803,5809 **** if (head == ss) { /* First operand is scalar. We build the chain in reverse order, so ! add the scarar SS after the second operand. */ head = head2; while (head && head->next != ss) head = head->next; --- 6005,6011 ---- if (head == ss) { /* First operand is scalar. We build the chain in reverse order, so ! add the scalar SS after the second operand. */ head = head2; while (head && head->next != ss) head = head->next; diff -Nrcpad gcc-4.3.3/gcc/fortran/trans-array.h gcc-4.4.0/gcc/fortran/trans-array.h *** gcc-4.3.3/gcc/fortran/trans-array.h Sun Jul 27 11:41:35 2008 --- gcc-4.4.0/gcc/fortran/trans-array.h Sat Nov 1 13:26:19 2008 *************** *** 1,6 **** /* Header for array handling functions ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software ! Foundation, Inc. Contributed by Paul Brook This file is part of GCC. --- 1,6 ---- /* Header for array handling functions ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 ! Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. *************** along with GCC; see the file COPYING3. *** 20,26 **** . */ /* Generate code to free an array. */ ! tree gfc_array_deallocate (tree, tree); /* Generate code to initialize an allocate an array. Statements are added to se, which should contain an expression for the array descriptor. */ --- 20,26 ---- . */ /* Generate code to free an array. */ ! tree gfc_array_deallocate (tree, tree, gfc_expr*); /* Generate code to initialize an allocate an array. Statements are added to se, which should contain an expression for the array descriptor. */ *************** void gfc_set_loop_bounds_from_array_spec *** 32,38 **** /* Generate code to create a temporary array. */ tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_loopinfo *, ! gfc_ss_info *, tree, bool, bool, bool); /* Generate function entry code for allocation of compiler allocated array variables. */ --- 32,39 ---- /* Generate code to create a temporary array. */ tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_loopinfo *, ! gfc_ss_info *, tree, tree, bool, bool, bool, ! locus *); /* Generate function entry code for allocation of compiler allocated array variables. */ *************** void gfc_trans_scalarizing_loops (gfc_lo *** 88,94 **** /* Mark the end of the main loop body and the start of the copying loop. */ void gfc_trans_scalarized_loop_boundary (gfc_loopinfo *, stmtblock_t *); /* Initialize the scalarization loop parameters. */ ! void gfc_conv_loop_setup (gfc_loopinfo *); /* Resolve array assignment dependencies. */ void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *); /* Build a null array descriptor constructor. */ --- 89,95 ---- /* Mark the end of the main loop body and the start of the copying loop. */ void gfc_trans_scalarized_loop_boundary (gfc_loopinfo *, stmtblock_t *); /* Initialize the scalarization loop parameters. */ ! void gfc_conv_loop_setup (gfc_loopinfo *, locus *); /* Resolve array assignment dependencies. */ void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *); /* Build a null array descriptor constructor. */ *************** void gfc_conv_tmp_ref (gfc_se *); *** 105,112 **** void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *, gfc_ss *); /* Convert an array for passing as an actual function parameter. */ void gfc_conv_array_parameter (gfc_se *, gfc_expr *, gfc_ss *, int, ! const gfc_symbol *); ! /* Evaluate and transpose a matrix expression. */ void gfc_conv_array_transpose (gfc_se *, gfc_expr *); --- 106,112 ---- void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *, gfc_ss *); /* Convert an array for passing as an actual function parameter. */ void gfc_conv_array_parameter (gfc_se *, gfc_expr *, gfc_ss *, int, ! const gfc_symbol *, const char *); /* Evaluate and transpose a matrix expression. */ void gfc_conv_array_transpose (gfc_se *, gfc_expr *); *************** tree gfc_conv_array_ubound (tree, int); *** 120,130 **** /* Build expressions for accessing components of an array descriptor. */ tree gfc_conv_descriptor_data_get (tree); ! void gfc_conv_descriptor_data_set_internal (stmtblock_t *, tree, tree, bool); ! #define gfc_conv_descriptor_data_set(BLOCK, T1, T2) \ ! gfc_conv_descriptor_data_set_internal ((BLOCK), (T1), (T2), false) ! #define gfc_conv_descriptor_data_set_tuples(BLOCK, T1, T2) \ ! gfc_conv_descriptor_data_set_internal ((BLOCK), (T1), (T2), true) tree gfc_conv_descriptor_data_addr (tree); tree gfc_conv_descriptor_offset (tree); tree gfc_conv_descriptor_dtype (tree); --- 120,126 ---- /* Build expressions for accessing components of an array descriptor. */ tree gfc_conv_descriptor_data_get (tree); ! void gfc_conv_descriptor_data_set (stmtblock_t *, tree, tree); tree gfc_conv_descriptor_data_addr (tree); tree gfc_conv_descriptor_offset (tree); tree gfc_conv_descriptor_dtype (tree); *************** unsigned HOST_WIDE_INT gfc_constant_arra *** 141,144 **** tree gfc_build_constant_array_constructor (gfc_expr *, tree); /* Copy a string from src to dest. */ ! void gfc_trans_string_copy (stmtblock_t *, tree, tree, tree, tree); --- 137,140 ---- tree gfc_build_constant_array_constructor (gfc_expr *, tree); /* Copy a string from src to dest. */ ! void gfc_trans_string_copy (stmtblock_t *, tree, tree, int, tree, tree, int); diff -Nrcpad gcc-4.3.3/gcc/fortran/trans-common.c gcc-4.4.0/gcc/fortran/trans-common.c *** gcc-4.3.3/gcc/fortran/trans-common.c Tue Feb 5 21:06:32 2008 --- gcc-4.4.0/gcc/fortran/trans-common.c Mon Sep 22 11:45:02 2008 *************** *** 1,5 **** /* Common block and equivalence list handling ! Copyright (C) 2000, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Canqun Yang --- 1,5 ---- /* Common block and equivalence list handling ! Copyright (C) 2000, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Canqun Yang *************** build_field (segment_info *h, tree union *** 321,330 **** /* If this field is volatile, mark it. */ if (h->sym->attr.volatile_) { ! tree new; TREE_THIS_VOLATILE (field) = 1; ! new = build_qualified_type (TREE_TYPE (field), TYPE_QUAL_VOLATILE); ! TREE_TYPE (field) = new; } h->field = field; --- 321,330 ---- /* If this field is volatile, mark it. */ if (h->sym->attr.volatile_) { ! tree new_type; TREE_THIS_VOLATILE (field) = 1; ! new_type = build_qualified_type (TREE_TYPE (field), TYPE_QUAL_VOLATILE); ! TREE_TYPE (field) = new_type; } h->field = field; *************** build_common_decl (gfc_common_head *com, *** 416,421 **** --- 416,422 ---- SET_DECL_ASSEMBLER_NAME (decl, gfc_sym_mangled_common_id (com)); TREE_PUBLIC (decl) = 1; TREE_STATIC (decl) = 1; + DECL_IGNORED_P (decl) = 1; if (!com->is_bind_c) DECL_ALIGN (decl) = BIGGEST_ALIGNMENT; else *************** get_init_field (segment_info *head, tree *** 547,553 **** init = build_constructor (TREE_TYPE (field), v); TREE_CONSTANT (init) = 1; - TREE_INVARIANT (init) = 1; *field_init = init; --- 548,553 ---- *************** create_common (gfc_common_head *com, seg *** 657,663 **** gcc_assert (!VEC_empty (constructor_elt, v)); ctor = build_constructor (union_type, v); TREE_CONSTANT (ctor) = 1; - TREE_INVARIANT (ctor) = 1; TREE_STATIC (ctor) = 1; DECL_INITIAL (decl) = ctor; --- 657,662 ---- *************** create_common (gfc_common_head *com, seg *** 682,700 **** TREE_PUBLIC (var_decl) = TREE_PUBLIC (decl); TREE_STATIC (var_decl) = TREE_STATIC (decl); TREE_USED (var_decl) = TREE_USED (decl); if (s->sym->attr.target) TREE_ADDRESSABLE (var_decl) = 1; /* This is a fake variable just for debugging purposes. */ TREE_ASM_WRITTEN (var_decl) = 1; ! ! if (com) var_decl = pushdecl_top_level (var_decl); else gfc_add_decl_to_function (var_decl); SET_DECL_VALUE_EXPR (var_decl, ! build3 (COMPONENT_REF, TREE_TYPE (s->field), ! decl, s->field, NULL_TREE)); DECL_HAS_VALUE_EXPR_P (var_decl) = 1; GFC_DECL_COMMON_OR_EQUIV (var_decl) = 1; --- 681,705 ---- TREE_PUBLIC (var_decl) = TREE_PUBLIC (decl); TREE_STATIC (var_decl) = TREE_STATIC (decl); TREE_USED (var_decl) = TREE_USED (decl); + if (s->sym->attr.use_assoc) + DECL_IGNORED_P (var_decl) = 1; if (s->sym->attr.target) TREE_ADDRESSABLE (var_decl) = 1; /* This is a fake variable just for debugging purposes. */ TREE_ASM_WRITTEN (var_decl) = 1; ! ! /* To preserve identifier names in COMMON, chain to procedure ! scope unless at top level in a module definition. */ ! if (com ! && s->sym->ns->proc_name ! && s->sym->ns->proc_name->attr.flavor == FL_MODULE) var_decl = pushdecl_top_level (var_decl); else gfc_add_decl_to_function (var_decl); SET_DECL_VALUE_EXPR (var_decl, ! fold_build3 (COMPONENT_REF, TREE_TYPE (s->field), ! decl, s->field, NULL_TREE)); DECL_HAS_VALUE_EXPR_P (var_decl) = 1; GFC_DECL_COMMON_OR_EQUIV (var_decl) = 1; *************** find_equivalence (segment_info *n) *** 953,959 **** segment list multiple times to include indirect equivalences. Since a new segment_info can inserted at the beginning of the segment list, depending on its offset, we have to force a final pass through the ! loop by demanding that completion sees a pass with no matches; ie. all symbols with equiv_built set and no new equivalences found. */ static void --- 958,964 ---- segment list multiple times to include indirect equivalences. Since a new segment_info can inserted at the beginning of the segment list, depending on its offset, we have to force a final pass through the ! loop by demanding that completion sees a pass with no matches; i.e., all symbols with equiv_built set and no new equivalences found. */ static void *************** translate_common (gfc_common_head *commo *** 1054,1060 **** --- 1059,1067 ---- bool saw_equiv; common_segment = NULL; + offset = 0; current_offset = 0; + align = 1; max_align = 1; saw_equiv = false; *************** translate_common (gfc_common_head *commo *** 1095,1110 **** "extension to COMMON '%s' at %L", sym->name, common->name, &common->where); ! offset = align_segment (&align); if (offset & (max_align - 1)) { /* The required offset conflicts with previous alignment requirements. Insert padding immediately before this segment. */ ! gfc_warning ("Padding of %d bytes required before '%s' in " ! "COMMON '%s' at %L", (int)offset, s->sym->name, ! common->name, &common->where); } else { --- 1102,1128 ---- "extension to COMMON '%s' at %L", sym->name, common->name, &common->where); ! if (gfc_option.flag_align_commons) ! offset = align_segment (&align); if (offset & (max_align - 1)) { /* The required offset conflicts with previous alignment requirements. Insert padding immediately before this segment. */ ! if (gfc_option.warn_align_commons) ! { ! if (strcmp (common->name, BLANK_COMMON_NAME)) ! gfc_warning ("Padding of %d bytes required before '%s' in " ! "COMMON '%s' at %L; reorder elements or use " ! "-fno-align-commons", (int)offset, ! s->sym->name, common->name, &common->where); ! else ! gfc_warning ("Padding of %d bytes required before '%s' in " ! "COMMON at %L; reorder elements or use " ! "-fno-align-commons", (int)offset, ! s->sym->name, &common->where); ! } } else { *************** translate_common (gfc_common_head *commo *** 1133,1142 **** return; } ! if (common_segment->offset != 0) { ! gfc_warning ("COMMON '%s' at %L requires %d bytes of padding at start", ! common->name, &common->where, (int)common_segment->offset); } create_common (common, common_segment, saw_equiv); --- 1151,1166 ---- return; } ! if (common_segment->offset != 0 && gfc_option.warn_align_commons) { ! if (strcmp (common->name, BLANK_COMMON_NAME)) ! gfc_warning ("COMMON '%s' at %L requires %d bytes of padding at start; " ! "reorder elements or use -fno-align-commons", ! common->name, &common->where, (int)common_segment->offset); ! else ! gfc_warning ("COMMON at %L requires %d bytes of padding at start; " ! "reorder elements or use -fno-align-commons", ! &common->where, (int)common_segment->offset); } create_common (common, common_segment, saw_equiv); *************** gfc_trans_common (gfc_namespace *ns) *** 1220,1233 **** if (ns->blank_common.head != NULL) { c = gfc_get_common_head (); ! ! /* We've lost the real location, so use the location of the ! enclosing procedure. */ ! if (ns->proc_name != NULL) ! c->where = ns->proc_name->declared_at; ! else ! c->where = ns->blank_common.head->common_head->where; ! strcpy (c->name, BLANK_COMMON_NAME); translate_common (c, ns->blank_common.head); } --- 1244,1250 ---- if (ns->blank_common.head != NULL) { c = gfc_get_common_head (); ! c->where = ns->blank_common.head->common_head->where; strcpy (c->name, BLANK_COMMON_NAME); translate_common (c, ns->blank_common.head); } diff -Nrcpad gcc-4.3.3/gcc/fortran/trans-const.c gcc-4.4.0/gcc/fortran/trans-const.c *** gcc-4.3.3/gcc/fortran/trans-const.c Wed Aug 1 16:29:36 2007 --- gcc-4.4.0/gcc/fortran/trans-const.c Wed Nov 12 17:01:51 2008 *************** *** 1,5 **** /* Translation of constants ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook --- 1,5 ---- /* Translation of constants ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Paul Brook *************** along with GCC; see the file COPYING3. *** 33,38 **** --- 33,39 ---- #include "trans.h" #include "trans-const.h" #include "trans-types.h" + #include "target-memory.h" tree gfc_rank_cst[GFC_MAX_DIMENSIONS + 1]; *************** gfc_build_const (tree type, tree intval) *** 66,71 **** --- 67,74 ---- return val; } + /* Build a string constant with C char type. */ + tree gfc_build_string_const (int length, const char *s) { *************** gfc_build_string_const (int length, cons *** 81,95 **** return str; } /* Build a Fortran character constant from a zero-terminated string. ! Since this is mainly used for error messages, the string will get ! translated. */ tree ! gfc_build_cstring_const (const char *msgid) { ! return gfc_build_string_const (strlen (msgid) + 1, _(msgid)); } /* Return a string constant with the given length. Used for static initializers. The constant will be padded or truncated to match length. */ --- 84,136 ---- return str; } + + /* Build a string constant with a type given by its kind; take care of + non-default character kinds. */ + + tree + gfc_build_wide_string_const (int kind, int length, const gfc_char_t *string) + { + int i; + tree str, len; + size_t size; + char *s; + + i = gfc_validate_kind (BT_CHARACTER, kind, false); + size = length * gfc_character_kinds[i].bit_size / 8; + + s = XCNEWVAR (char, size); + gfc_encode_character (kind, length, string, (unsigned char *) s, size); + + str = build_string (size, s); + gfc_free (s); + + len = build_int_cst (NULL_TREE, length); + TREE_TYPE (str) = + build_array_type (gfc_get_char_type (kind), + build_range_type (gfc_charlen_type_node, + integer_one_node, len)); + return str; + } + + /* Build a Fortran character constant from a zero-terminated string. ! There a two version of this function, one that translates the string ! and one that doesn't. */ tree ! gfc_build_cstring_const (const char *string) { ! return gfc_build_string_const (strlen (string) + 1, string); ! } ! ! tree ! gfc_build_localized_cstring_const (const char *msgid) ! { ! const char *localized = _(msgid); ! return gfc_build_string_const (strlen (localized) + 1, localized); } + /* Return a string constant with the given length. Used for static initializers. The constant will be padded or truncated to match length. */ *************** gfc_build_cstring_const (const char *msg *** 97,109 **** tree gfc_conv_string_init (tree length, gfc_expr * expr) { ! char *s; HOST_WIDE_INT len; int slen; tree str; gcc_assert (expr->expr_type == EXPR_CONSTANT); ! gcc_assert (expr->ts.type == BT_CHARACTER && expr->ts.kind == 1); gcc_assert (INTEGER_CST_P (length)); gcc_assert (TREE_INT_CST_HIGH (length) == 0); --- 138,151 ---- tree gfc_conv_string_init (tree length, gfc_expr * expr) { ! gfc_char_t *s; HOST_WIDE_INT len; int slen; tree str; + bool free_s = false; gcc_assert (expr->expr_type == EXPR_CONSTANT); ! gcc_assert (expr->ts.type == BT_CHARACTER); gcc_assert (INTEGER_CST_P (length)); gcc_assert (TREE_INT_CST_HIGH (length) == 0); *************** gfc_conv_string_init (tree length, gfc_e *** 112,125 **** if (len > slen) { ! s = gfc_getmem (len); ! memcpy (s, expr->value.character.string, slen); ! memset (&s[slen], ' ', len - slen); ! str = gfc_build_string_const (len, s); ! gfc_free (s); } else ! str = gfc_build_string_const (len, expr->value.character.string); return str; } --- 154,171 ---- if (len > slen) { ! s = gfc_get_wide_string (len); ! memcpy (s, expr->value.character.string, slen * sizeof (gfc_char_t)); ! gfc_wide_memset (&s[slen], ' ', len - slen); ! free_s = true; } else ! s = expr->value.character.string; ! ! str = gfc_build_wide_string_const (expr->ts.kind, len, s); ! ! if (free_s) ! gfc_free (s); return str; } *************** gfc_conv_tree_to_mpfr (mpfr_ptr f, tree *** 206,211 **** --- 252,259 ---- tree gfc_conv_constant_to_tree (gfc_expr * expr) { + tree res; + gcc_assert (expr->expr_type == EXPR_CONSTANT); /* If it is has a prescribed memory representation, we build a string *************** gfc_conv_constant_to_tree (gfc_expr * ex *** 215,252 **** { case BT_INTEGER: if (expr->representation.string) ! return build1 (VIEW_CONVERT_EXPR, ! gfc_get_int_type (expr->ts.kind), ! gfc_build_string_const (expr->representation.length, ! expr->representation.string)); else return gfc_conv_mpz_to_tree (expr->value.integer, expr->ts.kind); case BT_REAL: if (expr->representation.string) ! return build1 (VIEW_CONVERT_EXPR, ! gfc_get_real_type (expr->ts.kind), ! gfc_build_string_const (expr->representation.length, ! expr->representation.string)); else return gfc_conv_mpfr_to_tree (expr->value.real, expr->ts.kind); case BT_LOGICAL: if (expr->representation.string) ! return build1 (VIEW_CONVERT_EXPR, ! gfc_get_logical_type (expr->ts.kind), ! gfc_build_string_const (expr->representation.length, ! expr->representation.string)); else return build_int_cst (gfc_get_logical_type (expr->ts.kind), ! expr->value.logical); case BT_COMPLEX: if (expr->representation.string) ! return build1 (VIEW_CONVERT_EXPR, ! gfc_get_complex_type (expr->ts.kind), ! gfc_build_string_const (expr->representation.length, ! expr->representation.string)); else { tree real = gfc_conv_mpfr_to_tree (expr->value.complex.r, --- 263,306 ---- { case BT_INTEGER: if (expr->representation.string) ! return fold_build1 (VIEW_CONVERT_EXPR, ! gfc_get_int_type (expr->ts.kind), ! gfc_build_string_const (expr->representation.length, ! expr->representation.string)); else return gfc_conv_mpz_to_tree (expr->value.integer, expr->ts.kind); case BT_REAL: if (expr->representation.string) ! return fold_build1 (VIEW_CONVERT_EXPR, ! gfc_get_real_type (expr->ts.kind), ! gfc_build_string_const (expr->representation.length, ! expr->representation.string)); else return gfc_conv_mpfr_to_tree (expr->value.real, expr->ts.kind); case BT_LOGICAL: if (expr->representation.string) ! { ! tree tmp = fold_build1 (VIEW_CONVERT_EXPR, ! gfc_get_int_type (expr->ts.kind), ! gfc_build_string_const (expr->representation.length, ! expr->representation.string)); ! if (!integer_zerop (tmp) && !integer_onep (tmp)) ! gfc_warning ("Assigning value other than 0 or 1 to LOGICAL" ! " has undefined result at %L", &expr->where); ! return fold_convert (gfc_get_logical_type (expr->ts.kind), tmp); ! } else return build_int_cst (gfc_get_logical_type (expr->ts.kind), ! expr->value.logical); case BT_COMPLEX: if (expr->representation.string) ! return fold_build1 (VIEW_CONVERT_EXPR, ! gfc_get_complex_type (expr->ts.kind), ! gfc_build_string_const (expr->representation.length, ! expr->representation.string)); else { tree real = gfc_conv_mpfr_to_tree (expr->value.complex.r, *************** gfc_conv_constant_to_tree (gfc_expr * ex *** 259,266 **** } case BT_CHARACTER: ! return gfc_build_string_const (expr->value.character.length, ! expr->value.character.string); case BT_HOLLERITH: return gfc_build_string_const (expr->representation.length, --- 313,322 ---- } case BT_CHARACTER: ! res = gfc_build_wide_string_const (expr->ts.kind, ! expr->value.character.length, ! expr->value.character.string); ! return res; case BT_HOLLERITH: return gfc_build_string_const (expr->representation.length, diff -Nrcpad gcc-4.3.3/gcc/fortran/trans-const.h gcc-4.4.0/gcc/fortran/trans-const.h *** gcc-4.3.3/gcc/fortran/trans-const.h Wed Aug 1 16:29:36 2007 --- gcc-4.4.0/gcc/fortran/trans-const.h Sun May 18 22:45:05 2008 *************** *** 1,5 **** /* Header for code constant translation functions ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook --- 1,5 ---- /* Header for code constant translation functions ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Paul Brook *************** tree gfc_conv_constant_to_tree (gfc_expr *** 37,43 **** --- 37,45 ---- void gfc_conv_constant (gfc_se *, gfc_expr *); tree gfc_build_string_const (int, const char *); + tree gfc_build_wide_string_const (int, int, const gfc_char_t *); tree gfc_build_cstring_const (const char *); + tree gfc_build_localized_cstring_const (const char *); /* Translate a string constant for a static initializer. */ tree gfc_conv_string_init (tree, gfc_expr *); diff -Nrcpad gcc-4.3.3/gcc/fortran/trans-decl.c gcc-4.4.0/gcc/fortran/trans-decl.c *** gcc-4.3.3/gcc/fortran/trans-decl.c Tue Dec 23 01:32:33 2008 --- gcc-4.4.0/gcc/fortran/trans-decl.c Wed Apr 8 14:03:33 2009 *************** *** 1,6 **** /* Backend function setup ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software ! Foundation, Inc. Contributed by Paul Brook This file is part of GCC. --- 1,6 ---- /* Backend function setup ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 ! Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. *************** along with GCC; see the file COPYING3. *** 26,32 **** #include "coretypes.h" #include "tree.h" #include "tree-dump.h" ! #include "tree-gimple.h" #include "ggc.h" #include "toplev.h" #include "tm.h" --- 26,32 ---- #include "coretypes.h" #include "tree.h" #include "tree-dump.h" ! #include "gimple.h" #include "ggc.h" #include "toplev.h" #include "tm.h" *************** along with GCC; see the file COPYING3. *** 35,40 **** --- 35,41 ---- #include "function.h" #include "flags.h" #include "cgraph.h" + #include "debug.h" #include "gfortran.h" #include "trans.h" #include "trans-types.h" *************** tree gfor_fndecl_pause_numeric; *** 77,85 **** tree gfor_fndecl_pause_string; tree gfor_fndecl_stop_numeric; tree gfor_fndecl_stop_string; - tree gfor_fndecl_select_string; tree gfor_fndecl_runtime_error; tree gfor_fndecl_runtime_error_at; tree gfor_fndecl_os_error; tree gfor_fndecl_generate_error; tree gfor_fndecl_set_fpe; --- 78,86 ---- tree gfor_fndecl_pause_string; tree gfor_fndecl_stop_numeric; tree gfor_fndecl_stop_string; tree gfor_fndecl_runtime_error; tree gfor_fndecl_runtime_error_at; + tree gfor_fndecl_runtime_warning_at; tree gfor_fndecl_os_error; tree gfor_fndecl_generate_error; tree gfor_fndecl_set_fpe; *************** gfc_powdecl_list gfor_fndecl_math_powi[4 *** 102,111 **** tree gfor_fndecl_math_ishftc4; tree gfor_fndecl_math_ishftc8; tree gfor_fndecl_math_ishftc16; - tree gfor_fndecl_math_exponent4; - tree gfor_fndecl_math_exponent8; - tree gfor_fndecl_math_exponent10; - tree gfor_fndecl_math_exponent16; /* String functions. */ --- 103,108 ---- *************** tree gfor_fndecl_string_trim; *** 120,125 **** --- 117,139 ---- tree gfor_fndecl_string_minmax; tree gfor_fndecl_adjustl; tree gfor_fndecl_adjustr; + tree gfor_fndecl_select_string; + tree gfor_fndecl_compare_string_char4; + tree gfor_fndecl_concat_string_char4; + tree gfor_fndecl_string_len_trim_char4; + tree gfor_fndecl_string_index_char4; + tree gfor_fndecl_string_scan_char4; + tree gfor_fndecl_string_verify_char4; + tree gfor_fndecl_string_trim_char4; + tree gfor_fndecl_string_minmax_char4; + tree gfor_fndecl_adjustl_char4; + tree gfor_fndecl_adjustr_char4; + tree gfor_fndecl_select_string_char4; + + + /* Conversion between character kinds. */ + tree gfor_fndecl_convert_char1_to_char4; + tree gfor_fndecl_convert_char4_to_char1; /* Other misc. runtime library functions. */ *************** tree gfor_fndecl_size0; *** 128,134 **** tree gfor_fndecl_size1; tree gfor_fndecl_iargc; ! /* Intrinsic functions implemented in FORTRAN. */ tree gfor_fndecl_si_kind; tree gfor_fndecl_sr_kind; --- 142,149 ---- tree gfor_fndecl_size1; tree gfor_fndecl_iargc; ! /* Intrinsic functions implemented in Fortran. */ ! tree gfor_fndecl_sc_kind; tree gfor_fndecl_si_kind; tree gfor_fndecl_sr_kind; *************** gfc_get_return_label (void) *** 224,235 **** void gfc_set_decl_location (tree decl, locus * loc) { - #ifdef USE_MAPPED_LOCATION DECL_SOURCE_LOCATION (decl) = loc->lb->location; - #else - DECL_SOURCE_LINE (decl) = loc->lb->linenum; - DECL_SOURCE_FILE (decl) = loc->lb->file->filename; - #endif } --- 239,245 ---- *************** gfc_finish_decl (tree decl) *** 453,459 **** static void gfc_finish_var_decl (tree decl, gfc_symbol * sym) { ! tree new; /* TREE_ADDRESSABLE means the address of this variable is actually needed. This is the equivalent of the TARGET variables. We also need to set this if the variable is passed by reference in a --- 463,469 ---- static void gfc_finish_var_decl (tree decl, gfc_symbol * sym) { ! tree new_type; /* TREE_ADDRESSABLE means the address of this variable is actually needed. This is the equivalent of the TARGET variables. We also need to set this if the variable is passed by reference in a *************** gfc_finish_var_decl (tree decl, gfc_symb *** 517,523 **** a default initializer; this must be applied each time the variable comes into scope it therefore need not be static. These variables are SAVE_NONE but have an initializer. Otherwise explicitly ! intitialized variables are SAVE_IMPLICIT and explicitly saved are SAVE_EXPLICIT. */ if (!sym->attr.use_assoc && (sym->attr.save != SAVE_NONE || sym->attr.data --- 527,533 ---- a default initializer; this must be applied each time the variable comes into scope it therefore need not be static. These variables are SAVE_NONE but have an initializer. Otherwise explicitly ! initialized variables are SAVE_IMPLICIT and explicitly saved are SAVE_EXPLICIT. */ if (!sym->attr.use_assoc && (sym->attr.save != SAVE_NONE || sym->attr.data *************** gfc_finish_var_decl (tree decl, gfc_symb *** 527,534 **** if (sym->attr.volatile_) { TREE_THIS_VOLATILE (decl) = 1; ! new = build_qualified_type (TREE_TYPE (decl), TYPE_QUAL_VOLATILE); ! TREE_TYPE (decl) = new; } /* Keep variables larger than max-stack-var-size off stack. */ --- 537,544 ---- if (sym->attr.volatile_) { TREE_THIS_VOLATILE (decl) = 1; ! new_type = build_qualified_type (TREE_TYPE (decl), TYPE_QUAL_VOLATILE); ! TREE_TYPE (decl) = new_type; } /* Keep variables larger than max-stack-var-size off stack. */ *************** gfc_build_qualified_array (tree decl, gf *** 686,698 **** { tree size, range; ! size = build2 (MINUS_EXPR, gfc_array_index_type, ! GFC_TYPE_ARRAY_SIZE (type), gfc_index_one_node); range = build_range_type (gfc_array_index_type, gfc_index_zero_node, size); TYPE_DOMAIN (type) = range; layout_type (type); } } --- 696,752 ---- { tree size, range; ! size = fold_build2 (MINUS_EXPR, gfc_array_index_type, ! GFC_TYPE_ARRAY_SIZE (type), gfc_index_one_node); range = build_range_type (gfc_array_index_type, gfc_index_zero_node, size); TYPE_DOMAIN (type) = range; layout_type (type); } + + if (write_symbols == NO_DEBUG) + return; + + if (TYPE_NAME (type) != NULL_TREE + && GFC_TYPE_ARRAY_UBOUND (type, sym->as->rank - 1) != NULL_TREE + && TREE_CODE (GFC_TYPE_ARRAY_UBOUND (type, sym->as->rank - 1)) == VAR_DECL) + { + tree gtype = DECL_ORIGINAL_TYPE (TYPE_NAME (type)); + + for (dim = 0; dim < sym->as->rank - 1; dim++) + { + gcc_assert (TREE_CODE (gtype) == ARRAY_TYPE); + gtype = TREE_TYPE (gtype); + } + gcc_assert (TREE_CODE (gtype) == ARRAY_TYPE); + if (TYPE_MAX_VALUE (TYPE_DOMAIN (gtype)) == NULL) + TYPE_NAME (type) = NULL_TREE; + } + + if (TYPE_NAME (type) == NULL_TREE) + { + tree gtype = TREE_TYPE (type), rtype, type_decl; + + for (dim = sym->as->rank - 1; dim >= 0; dim--) + { + rtype = build_range_type (gfc_array_index_type, + GFC_TYPE_ARRAY_LBOUND (type, dim), + GFC_TYPE_ARRAY_UBOUND (type, dim)); + gtype = build_array_type (gtype, rtype); + /* Ensure the bound variables aren't optimized out at -O0. */ + if (!optimize) + { + if (GFC_TYPE_ARRAY_LBOUND (type, dim) + && TREE_CODE (GFC_TYPE_ARRAY_LBOUND (type, dim)) == VAR_DECL) + DECL_IGNORED_P (GFC_TYPE_ARRAY_LBOUND (type, dim)) = 0; + if (GFC_TYPE_ARRAY_UBOUND (type, dim) + && TREE_CODE (GFC_TYPE_ARRAY_UBOUND (type, dim)) == VAR_DECL) + DECL_IGNORED_P (GFC_TYPE_ARRAY_UBOUND (type, dim)) = 0; + } + } + TYPE_NAME (type) = type_decl = build_decl (TYPE_DECL, NULL, gtype); + DECL_ORIGINAL_TYPE (type_decl) = gtype; + } } *************** gfc_build_dummy_array_decl (gfc_symbol * *** 741,747 **** /* Create a descriptorless array pointer. */ as = sym->as; packed = PACKED_NO; ! if (!gfc_option.flag_repack_arrays) { if (as->type == AS_ASSUMED_SIZE) packed = PACKED_FULL; --- 795,804 ---- /* Create a descriptorless array pointer. */ as = sym->as; packed = PACKED_NO; ! ! /* Even when -frepack-arrays is used, symbols with TARGET attribute ! are not repacked. */ ! if (!gfc_option.flag_repack_arrays || sym->attr.target) { if (as->type == AS_ASSUMED_SIZE) packed = PACKED_FULL; *************** gfc_get_symbol_decl (gfc_symbol * sym) *** 958,967 **** if (sym->backend_decl) return sym->backend_decl; ! /* Catch function declarations. Only used for actual parameters. */ if (sym->attr.flavor == FL_PROCEDURE) { decl = gfc_get_extern_function_decl (sym); return decl; } --- 1015,1026 ---- if (sym->backend_decl) return sym->backend_decl; ! /* Catch function declarations. Only used for actual parameters and ! procedure pointers. */ if (sym->attr.flavor == FL_PROCEDURE) { decl = gfc_get_extern_function_decl (sym); + gfc_set_decl_location (decl, &sym->declared_at); return decl; } *************** gfc_get_symbol_decl (gfc_symbol * sym) *** 982,988 **** This is done here rather than in gfc_finish_var_decl because it is different for string length variables. */ if (sym->module) ! SET_DECL_ASSEMBLER_NAME (decl, gfc_sym_mangled_identifier (sym)); if (sym->attr.dimension) { --- 1041,1051 ---- This is done here rather than in gfc_finish_var_decl because it is different for string length variables. */ if (sym->module) ! { ! SET_DECL_ASSEMBLER_NAME (decl, gfc_sym_mangled_identifier (sym)); ! if (sym->attr.use_assoc) ! DECL_IGNORED_P (decl) = 1; ! } if (sym->attr.dimension) { *************** gfc_get_symbol_decl (gfc_symbol * sym) *** 1044,1053 **** span = build_decl (VAR_DECL, create_tmp_var_name ("span"), gfc_array_index_type); gfc_finish_var_decl (span, sym); ! TREE_STATIC (span) = 1; ! DECL_INITIAL (span) = build_int_cst (NULL_TREE, 0); GFC_DECL_SPAN (decl) = span; } sym->backend_decl = decl; --- 1107,1118 ---- span = build_decl (VAR_DECL, create_tmp_var_name ("span"), gfc_array_index_type); gfc_finish_var_decl (span, sym); ! TREE_STATIC (span) = TREE_STATIC (decl); ! DECL_ARTIFICIAL (span) = 1; ! DECL_INITIAL (span) = build_int_cst (gfc_array_index_type, 0); GFC_DECL_SPAN (decl) = span; + GFC_TYPE_ARRAY_SPAN (TREE_TYPE (decl)) = span; } sym->backend_decl = decl; *************** gfc_restore_sym (gfc_symbol * sym, gfc_s *** 1093,1098 **** --- 1158,1215 ---- } + /* Declare a procedure pointer. */ + + static tree + get_proc_pointer_decl (gfc_symbol *sym) + { + tree decl; + + decl = sym->backend_decl; + if (decl) + return decl; + + decl = build_decl (VAR_DECL, get_identifier (sym->name), + build_pointer_type (gfc_get_function_type (sym))); + + if ((sym->ns->proc_name + && sym->ns->proc_name->backend_decl == current_function_decl) + || sym->attr.contained) + gfc_add_decl_to_function (decl); + else if (sym->ns->proc_name->attr.flavor != FL_MODULE) + gfc_add_decl_to_parent_function (decl); + + sym->backend_decl = decl; + + /* If a variable is USE associated, it's always external. */ + if (sym->attr.use_assoc) + { + DECL_EXTERNAL (decl) = 1; + TREE_PUBLIC (decl) = 1; + } + else if (sym->module && sym->ns->proc_name->attr.flavor == FL_MODULE) + { + /* This is the declaration of a module variable. */ + TREE_PUBLIC (decl) = 1; + TREE_STATIC (decl) = 1; + } + + if (!sym->attr.use_assoc + && (sym->attr.save != SAVE_NONE || sym->attr.data + || (sym->value && sym->ns->proc_name->attr.is_main_program))) + TREE_STATIC (decl) = 1; + + if (TREE_STATIC (decl) && sym->value) + { + /* Add static initializer. */ + DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts, + TREE_TYPE (decl), sym->attr.dimension, sym->attr.proc_pointer); + } + + return decl; + } + + /* Get a basic decl for an external function. */ tree *************** gfc_get_extern_function_decl (gfc_symbol *** 1115,1120 **** --- 1232,1240 ---- to know that. */ gcc_assert (!(sym->attr.entry || sym->attr.entry_master)); + if (sym->attr.proc_pointer) + return get_proc_pointer_decl (sym); + if (sym->attr.intrinsic) { /* Call the resolution function to get the actual name. This is *************** gfc_get_extern_function_decl (gfc_symbol *** 1205,1211 **** if (sym->attr.pure || sym->attr.elemental) { if (sym->attr.function && !gfc_return_by_reference (sym)) ! DECL_IS_PURE (fndecl) = 1; /* TODO: check if pure SUBROUTINEs don't have INTENT(OUT) parameters and don't use alternate returns (is this allowed?). In that case, calls to them are meaningless, and --- 1325,1331 ---- if (sym->attr.pure || sym->attr.elemental) { if (sym->attr.function && !gfc_return_by_reference (sym)) ! DECL_PURE_P (fndecl) = 1; /* TODO: check if pure SUBROUTINEs don't have INTENT(OUT) parameters and don't use alternate returns (is this allowed?). In that case, calls to them are meaningless, and *************** build_function_decl (gfc_symbol * sym) *** 1247,1253 **** /* Allow only one nesting level. Allow public declarations. */ gcc_assert (current_function_decl == NULL_TREE ! || DECL_CONTEXT (current_function_decl) == NULL_TREE); type = gfc_get_function_type (sym); fndecl = build_decl (FUNCTION_DECL, gfc_sym_identifier (sym), type); --- 1367,1375 ---- /* Allow only one nesting level. Allow public declarations. */ gcc_assert (current_function_decl == NULL_TREE ! || DECL_CONTEXT (current_function_decl) == NULL_TREE ! || TREE_CODE (DECL_CONTEXT (current_function_decl)) ! == NAMESPACE_DECL); type = gfc_get_function_type (sym); fndecl = build_decl (FUNCTION_DECL, gfc_sym_identifier (sym), type); *************** build_function_decl (gfc_symbol * sym) *** 1332,1338 **** including an alternate return. In that case it can also be marked as PURE. See also in gfc_get_extern_function_decl(). */ if (attr.function && !gfc_return_by_reference (sym)) ! DECL_IS_PURE (fndecl) = 1; TREE_SIDE_EFFECTS (fndecl) = 0; } --- 1454,1460 ---- including an alternate return. In that case it can also be marked as PURE. See also in gfc_get_extern_function_decl(). */ if (attr.function && !gfc_return_by_reference (sym)) ! DECL_PURE_P (fndecl) = 1; TREE_SIDE_EFFECTS (fndecl) = 0; } *************** create_function_arglist (gfc_symbol * sy *** 1529,1535 **** type = gfc_sym_type (f->sym); } ! /* Build a the argument declaration. */ parm = build_decl (PARM_DECL, gfc_sym_identifier (f->sym), type); /* Fill in arg stuff. */ --- 1651,1660 ---- type = gfc_sym_type (f->sym); } ! if (f->sym->attr.proc_pointer) ! type = build_pointer_type (type); ! ! /* Build the argument declaration. */ parm = build_decl (PARM_DECL, gfc_sym_identifier (f->sym), type); /* Fill in arg stuff. */ *************** create_function_arglist (gfc_symbol * sy *** 1537,1542 **** --- 1662,1671 ---- DECL_ARG_TYPE (parm) = TREE_VALUE (typelist); /* All implementation args are read-only. */ TREE_READONLY (parm) = 1; + if (POINTER_TYPE_P (type) + && (!f->sym->attr.proc_pointer + && f->sym->attr.flavor != FL_PROCEDURE)) + DECL_BY_REFERENCE (parm) = 1; gfc_finish_decl (parm); *************** trans_function_start (gfc_symbol * sym) *** 1610,1616 **** call expand_expr to calculate the size of a variable-sized array. We haven't necessarily assigned RTL to all variables yet, so it's not safe to try to expand expressions involving them. */ ! cfun->x_dont_save_pending_sizes_p = 1; /* function.c requires a push at the start of the function. */ pushlevel (0); --- 1739,1745 ---- call expand_expr to calculate the size of a variable-sized array. We haven't necessarily assigned RTL to all variables yet, so it's not safe to try to expand expressions involving them. */ ! cfun->dont_save_pending_sizes_p = 1; /* function.c requires a push at the start of the function. */ pushlevel (0); *************** build_entry_thunks (gfc_namespace * ns) *** 1647,1653 **** thunk_fndecl = thunk_sym->backend_decl; ! gfc_start_block (&body); /* Pass extra parameter identifying this entry point. */ tmp = build_int_cst (gfc_array_index_type, el->id); --- 1776,1782 ---- thunk_fndecl = thunk_sym->backend_decl; ! gfc_init_block (&body); /* Pass extra parameter identifying this entry point. */ tmp = build_int_cst (gfc_array_index_type, el->id); *************** build_entry_thunks (gfc_namespace * ns) *** 1726,1734 **** pushdecl (union_decl); DECL_CONTEXT (union_decl) = current_function_decl; ! tmp = build2 (MODIFY_EXPR, ! TREE_TYPE (union_decl), ! union_decl, tmp); gfc_add_expr_to_block (&body, tmp); for (field = TYPE_FIELDS (TREE_TYPE (union_decl)); --- 1855,1862 ---- pushdecl (union_decl); DECL_CONTEXT (union_decl) = current_function_decl; ! tmp = fold_build2 (MODIFY_EXPR, TREE_TYPE (union_decl), ! union_decl, tmp); gfc_add_expr_to_block (&body, tmp); for (field = TYPE_FIELDS (TREE_TYPE (union_decl)); *************** build_entry_thunks (gfc_namespace * ns) *** 1737,1763 **** thunk_sym->result->name) == 0) break; gcc_assert (field != NULL_TREE); ! tmp = build3 (COMPONENT_REF, TREE_TYPE (field), union_decl, field, ! NULL_TREE); ! tmp = build2 (MODIFY_EXPR, ! TREE_TYPE (DECL_RESULT (current_function_decl)), ! DECL_RESULT (current_function_decl), tmp); tmp = build1_v (RETURN_EXPR, tmp); } else if (TREE_TYPE (DECL_RESULT (current_function_decl)) != void_type_node) { ! tmp = build2 (MODIFY_EXPR, ! TREE_TYPE (DECL_RESULT (current_function_decl)), ! DECL_RESULT (current_function_decl), tmp); tmp = build1_v (RETURN_EXPR, tmp); } gfc_add_expr_to_block (&body, tmp); /* Finish off this function and send it for code generation. */ DECL_SAVED_TREE (thunk_fndecl) = gfc_finish_block (&body); poplevel (1, 0, 1); BLOCK_SUPERCONTEXT (DECL_INITIAL (thunk_fndecl)) = thunk_fndecl; /* Output the GENERIC tree. */ dump_function (TDI_original, thunk_fndecl); --- 1865,1895 ---- thunk_sym->result->name) == 0) break; gcc_assert (field != NULL_TREE); ! tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field), ! union_decl, field, NULL_TREE); ! tmp = fold_build2 (MODIFY_EXPR, ! TREE_TYPE (DECL_RESULT (current_function_decl)), ! DECL_RESULT (current_function_decl), tmp); tmp = build1_v (RETURN_EXPR, tmp); } else if (TREE_TYPE (DECL_RESULT (current_function_decl)) != void_type_node) { ! tmp = fold_build2 (MODIFY_EXPR, ! TREE_TYPE (DECL_RESULT (current_function_decl)), ! DECL_RESULT (current_function_decl), tmp); tmp = build1_v (RETURN_EXPR, tmp); } gfc_add_expr_to_block (&body, tmp); /* Finish off this function and send it for code generation. */ DECL_SAVED_TREE (thunk_fndecl) = gfc_finish_block (&body); + tmp = getdecls (); poplevel (1, 0, 1); BLOCK_SUPERCONTEXT (DECL_INITIAL (thunk_fndecl)) = thunk_fndecl; + DECL_SAVED_TREE (thunk_fndecl) + = build3_v (BIND_EXPR, tmp, DECL_SAVED_TREE (thunk_fndecl), + DECL_INITIAL (thunk_fndecl)); /* Output the GENERIC tree. */ dump_function (TDI_original, thunk_fndecl); *************** gfc_get_fake_result_decl (gfc_symbol * s *** 1871,1878 **** break; gcc_assert (field != NULL_TREE); ! decl = build3 (COMPONENT_REF, TREE_TYPE (field), decl, field, ! NULL_TREE); } var = create_tmp_var_raw (TREE_TYPE (decl), sym->name); --- 2003,2010 ---- break; gcc_assert (field != NULL_TREE); ! decl = fold_build3 (COMPONENT_REF, TREE_TYPE (field), ! decl, field, NULL_TREE); } var = create_tmp_var_raw (TREE_TYPE (decl), sym->name); *************** gfc_build_intrinsic_function_decls (void *** 2013,2080 **** tree gfc_int8_type_node = gfc_get_int_type (8); tree gfc_int16_type_node = gfc_get_int_type (16); tree gfc_logical4_type_node = gfc_get_logical_type (4); ! tree gfc_real4_type_node = gfc_get_real_type (4); ! tree gfc_real8_type_node = gfc_get_real_type (8); ! tree gfc_real10_type_node = gfc_get_real_type (10); ! tree gfc_real16_type_node = gfc_get_real_type (16); /* String functions. */ gfor_fndecl_compare_string = gfc_build_library_function_decl (get_identifier (PREFIX("compare_string")), integer_type_node, 4, ! gfc_charlen_type_node, pchar_type_node, ! gfc_charlen_type_node, pchar_type_node); gfor_fndecl_concat_string = gfc_build_library_function_decl (get_identifier (PREFIX("concat_string")), ! void_type_node, ! 6, ! gfc_charlen_type_node, pchar_type_node, ! gfc_charlen_type_node, pchar_type_node, ! gfc_charlen_type_node, pchar_type_node); gfor_fndecl_string_len_trim = gfc_build_library_function_decl (get_identifier (PREFIX("string_len_trim")), ! gfc_int4_type_node, ! 2, gfc_charlen_type_node, ! pchar_type_node); gfor_fndecl_string_index = gfc_build_library_function_decl (get_identifier (PREFIX("string_index")), ! gfc_int4_type_node, ! 5, gfc_charlen_type_node, pchar_type_node, ! gfc_charlen_type_node, pchar_type_node, ! gfc_logical4_type_node); gfor_fndecl_string_scan = gfc_build_library_function_decl (get_identifier (PREFIX("string_scan")), ! gfc_int4_type_node, ! 5, gfc_charlen_type_node, pchar_type_node, ! gfc_charlen_type_node, pchar_type_node, ! gfc_logical4_type_node); gfor_fndecl_string_verify = gfc_build_library_function_decl (get_identifier (PREFIX("string_verify")), ! gfc_int4_type_node, ! 5, gfc_charlen_type_node, pchar_type_node, ! gfc_charlen_type_node, pchar_type_node, ! gfc_logical4_type_node); gfor_fndecl_string_trim = gfc_build_library_function_decl (get_identifier (PREFIX("string_trim")), ! void_type_node, ! 4, ! build_pointer_type (gfc_charlen_type_node), ! ppvoid_type_node, ! gfc_charlen_type_node, ! pchar_type_node); gfor_fndecl_string_minmax = gfc_build_library_function_decl (get_identifier (PREFIX("string_minmax")), ! void_type_node, -4, ! build_pointer_type (gfc_charlen_type_node), ! ppvoid_type_node, integer_type_node, ! integer_type_node); gfor_fndecl_ttynam = gfc_build_library_function_decl (get_identifier (PREFIX("ttynam")), --- 2145,2319 ---- tree gfc_int8_type_node = gfc_get_int_type (8); tree gfc_int16_type_node = gfc_get_int_type (16); tree gfc_logical4_type_node = gfc_get_logical_type (4); ! tree pchar1_type_node = gfc_get_pchar_type (1); ! tree pchar4_type_node = gfc_get_pchar_type (4); /* String functions. */ gfor_fndecl_compare_string = gfc_build_library_function_decl (get_identifier (PREFIX("compare_string")), integer_type_node, 4, ! gfc_charlen_type_node, pchar1_type_node, ! gfc_charlen_type_node, pchar1_type_node); gfor_fndecl_concat_string = gfc_build_library_function_decl (get_identifier (PREFIX("concat_string")), ! void_type_node, 6, ! gfc_charlen_type_node, pchar1_type_node, ! gfc_charlen_type_node, pchar1_type_node, ! gfc_charlen_type_node, pchar1_type_node); gfor_fndecl_string_len_trim = gfc_build_library_function_decl (get_identifier (PREFIX("string_len_trim")), ! gfc_int4_type_node, 2, ! gfc_charlen_type_node, pchar1_type_node); gfor_fndecl_string_index = gfc_build_library_function_decl (get_identifier (PREFIX("string_index")), ! gfc_int4_type_node, 5, ! gfc_charlen_type_node, pchar1_type_node, ! gfc_charlen_type_node, pchar1_type_node, ! gfc_logical4_type_node); gfor_fndecl_string_scan = gfc_build_library_function_decl (get_identifier (PREFIX("string_scan")), ! gfc_int4_type_node, 5, ! gfc_charlen_type_node, pchar1_type_node, ! gfc_charlen_type_node, pchar1_type_node, ! gfc_logical4_type_node); gfor_fndecl_string_verify = gfc_build_library_function_decl (get_identifier (PREFIX("string_verify")), ! gfc_int4_type_node, 5, ! gfc_charlen_type_node, pchar1_type_node, ! gfc_charlen_type_node, pchar1_type_node, ! gfc_logical4_type_node); gfor_fndecl_string_trim = gfc_build_library_function_decl (get_identifier (PREFIX("string_trim")), ! void_type_node, 4, ! build_pointer_type (gfc_charlen_type_node), ! build_pointer_type (pchar1_type_node), ! gfc_charlen_type_node, pchar1_type_node); gfor_fndecl_string_minmax = gfc_build_library_function_decl (get_identifier (PREFIX("string_minmax")), ! void_type_node, -4, ! build_pointer_type (gfc_charlen_type_node), ! build_pointer_type (pchar1_type_node), ! integer_type_node, integer_type_node); ! ! gfor_fndecl_adjustl = ! gfc_build_library_function_decl (get_identifier (PREFIX("adjustl")), ! void_type_node, 3, pchar1_type_node, ! gfc_charlen_type_node, pchar1_type_node); ! ! gfor_fndecl_adjustr = ! gfc_build_library_function_decl (get_identifier (PREFIX("adjustr")), ! void_type_node, 3, pchar1_type_node, ! gfc_charlen_type_node, pchar1_type_node); ! ! gfor_fndecl_select_string = ! gfc_build_library_function_decl (get_identifier (PREFIX("select_string")), ! integer_type_node, 4, pvoid_type_node, ! integer_type_node, pchar1_type_node, ! gfc_charlen_type_node); ! ! gfor_fndecl_compare_string_char4 = ! gfc_build_library_function_decl (get_identifier ! (PREFIX("compare_string_char4")), ! integer_type_node, 4, ! gfc_charlen_type_node, pchar4_type_node, ! gfc_charlen_type_node, pchar4_type_node); ! ! gfor_fndecl_concat_string_char4 = ! gfc_build_library_function_decl (get_identifier ! (PREFIX("concat_string_char4")), ! void_type_node, 6, ! gfc_charlen_type_node, pchar4_type_node, ! gfc_charlen_type_node, pchar4_type_node, ! gfc_charlen_type_node, pchar4_type_node); ! ! gfor_fndecl_string_len_trim_char4 = ! gfc_build_library_function_decl (get_identifier ! (PREFIX("string_len_trim_char4")), ! gfc_charlen_type_node, 2, ! gfc_charlen_type_node, pchar4_type_node); ! ! gfor_fndecl_string_index_char4 = ! gfc_build_library_function_decl (get_identifier ! (PREFIX("string_index_char4")), ! gfc_charlen_type_node, 5, ! gfc_charlen_type_node, pchar4_type_node, ! gfc_charlen_type_node, pchar4_type_node, ! gfc_logical4_type_node); ! ! gfor_fndecl_string_scan_char4 = ! gfc_build_library_function_decl (get_identifier ! (PREFIX("string_scan_char4")), ! gfc_charlen_type_node, 5, ! gfc_charlen_type_node, pchar4_type_node, ! gfc_charlen_type_node, pchar4_type_node, ! gfc_logical4_type_node); ! ! gfor_fndecl_string_verify_char4 = ! gfc_build_library_function_decl (get_identifier ! (PREFIX("string_verify_char4")), ! gfc_charlen_type_node, 5, ! gfc_charlen_type_node, pchar4_type_node, ! gfc_charlen_type_node, pchar4_type_node, ! gfc_logical4_type_node); ! ! gfor_fndecl_string_trim_char4 = ! gfc_build_library_function_decl (get_identifier ! (PREFIX("string_trim_char4")), ! void_type_node, 4, ! build_pointer_type (gfc_charlen_type_node), ! build_pointer_type (pchar4_type_node), ! gfc_charlen_type_node, pchar4_type_node); ! ! gfor_fndecl_string_minmax_char4 = ! gfc_build_library_function_decl (get_identifier ! (PREFIX("string_minmax_char4")), ! void_type_node, -4, ! build_pointer_type (gfc_charlen_type_node), ! build_pointer_type (pchar4_type_node), ! integer_type_node, integer_type_node); ! ! gfor_fndecl_adjustl_char4 = ! gfc_build_library_function_decl (get_identifier (PREFIX("adjustl_char4")), ! void_type_node, 3, pchar4_type_node, ! gfc_charlen_type_node, pchar4_type_node); ! ! gfor_fndecl_adjustr_char4 = ! gfc_build_library_function_decl (get_identifier (PREFIX("adjustr_char4")), ! void_type_node, 3, pchar4_type_node, ! gfc_charlen_type_node, pchar4_type_node); ! ! gfor_fndecl_select_string_char4 = ! gfc_build_library_function_decl (get_identifier ! (PREFIX("select_string_char4")), ! integer_type_node, 4, pvoid_type_node, ! integer_type_node, pvoid_type_node, ! gfc_charlen_type_node); ! ! ! /* Conversion between character kinds. */ ! ! gfor_fndecl_convert_char1_to_char4 = ! gfc_build_library_function_decl (get_identifier ! (PREFIX("convert_char1_to_char4")), ! void_type_node, 3, ! build_pointer_type (pchar4_type_node), ! gfc_charlen_type_node, pchar1_type_node); ! ! gfor_fndecl_convert_char4_to_char1 = ! gfc_build_library_function_decl (get_identifier ! (PREFIX("convert_char4_to_char1")), ! void_type_node, 3, ! build_pointer_type (pchar1_type_node), ! gfc_charlen_type_node, pchar4_type_node); ! ! /* Misc. functions. */ gfor_fndecl_ttynam = gfc_build_library_function_decl (get_identifier (PREFIX("ttynam")), *************** gfc_build_intrinsic_function_decls (void *** 2099,2131 **** gfc_charlen_type_node, gfc_int8_type_node); ! gfor_fndecl_adjustl = ! gfc_build_library_function_decl (get_identifier (PREFIX("adjustl")), ! void_type_node, ! 3, ! pchar_type_node, ! gfc_charlen_type_node, pchar_type_node); ! ! gfor_fndecl_adjustr = ! gfc_build_library_function_decl (get_identifier (PREFIX("adjustr")), ! void_type_node, ! 3, ! pchar_type_node, gfc_charlen_type_node, pchar_type_node); gfor_fndecl_si_kind = gfc_build_library_function_decl (get_identifier (PREFIX("selected_int_kind")), ! gfc_int4_type_node, ! 1, ! pvoid_type_node); gfor_fndecl_sr_kind = gfc_build_library_function_decl (get_identifier (PREFIX("selected_real_kind")), ! gfc_int4_type_node, ! 2, pvoid_type_node, ! pvoid_type_node); /* Power functions. */ { --- 2338,2359 ---- gfc_charlen_type_node, gfc_int8_type_node); ! gfor_fndecl_sc_kind = ! gfc_build_library_function_decl (get_identifier ! (PREFIX("selected_char_kind")), ! gfc_int4_type_node, 2, gfc_charlen_type_node, pchar_type_node); gfor_fndecl_si_kind = gfc_build_library_function_decl (get_identifier (PREFIX("selected_int_kind")), ! gfc_int4_type_node, 1, pvoid_type_node); gfor_fndecl_sr_kind = gfc_build_library_function_decl (get_identifier (PREFIX("selected_real_kind")), ! gfc_int4_type_node, 2, ! pvoid_type_node, pvoid_type_node); /* Power functions. */ { *************** gfc_build_intrinsic_function_decls (void *** 2202,2226 **** gfc_int4_type_node, gfc_int4_type_node); - gfor_fndecl_math_exponent4 = - gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r4")), - gfc_int4_type_node, - 1, gfc_real4_type_node); - gfor_fndecl_math_exponent8 = - gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r8")), - gfc_int4_type_node, - 1, gfc_real8_type_node); - if (gfc_real10_type_node) - gfor_fndecl_math_exponent10 = - gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r10")), - gfc_int4_type_node, 1, - gfc_real10_type_node); - if (gfc_real16_type_node) - gfor_fndecl_math_exponent16 = - gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r16")), - gfc_int4_type_node, 1, - gfc_real16_type_node); - /* BLAS functions. */ { tree pint = build_pointer_type (integer_type_node); --- 2430,2435 ---- *************** gfc_build_builtin_function_decls (void) *** 2311,2322 **** void_type_node, 2, pchar_type_node, gfc_int4_type_node); - gfor_fndecl_select_string = - gfc_build_library_function_decl (get_identifier (PREFIX("select_string")), - integer_type_node, 4, pvoid_type_node, - integer_type_node, pchar_type_node, - integer_type_node); - gfor_fndecl_runtime_error = gfc_build_library_function_decl (get_identifier (PREFIX("runtime_error")), void_type_node, -1, pchar_type_node); --- 2520,2525 ---- *************** gfc_build_builtin_function_decls (void) *** 2330,2335 **** --- 2533,2542 ---- /* The runtime_error_at function does not return. */ TREE_THIS_VOLATILE (gfor_fndecl_runtime_error_at) = 1; + gfor_fndecl_runtime_warning_at = + gfc_build_library_function_decl (get_identifier (PREFIX("runtime_warning_at")), + void_type_node, -2, pchar_type_node, + pchar_type_node); gfor_fndecl_generate_error = gfc_build_library_function_decl (get_identifier (PREFIX("generate_error")), void_type_node, 3, pvoid_type_node, *************** gfc_trans_dummy_character (gfc_symbol *s *** 2395,2401 **** gfc_start_block (&body); /* Evaluate the string length expression. */ ! gfc_conv_string_length (cl, &body); gfc_trans_vla_type_sizes (sym, &body); --- 2602,2608 ---- gfc_start_block (&body); /* Evaluate the string length expression. */ ! gfc_conv_string_length (cl, NULL, &body); gfc_trans_vla_type_sizes (sym, &body); *************** gfc_trans_auto_character_variable (gfc_s *** 2419,2425 **** gfc_start_block (&body); /* Evaluate the string length expression. */ ! gfc_conv_string_length (sym->ts.cl, &body); gfc_trans_vla_type_sizes (sym, &body); --- 2626,2632 ---- gfc_start_block (&body); /* Evaluate the string length expression. */ ! gfc_conv_string_length (sym->ts.cl, NULL, &body); gfc_trans_vla_type_sizes (sym, &body); *************** gfc_trans_auto_character_variable (gfc_s *** 2427,2433 **** /* Emit a DECL_EXPR for this variable, which will cause the gimplifier to allocate storage, and all that good stuff. */ ! tmp = build1 (DECL_EXPR, TREE_TYPE (decl), decl); gfc_add_expr_to_block (&body, tmp); gfc_add_expr_to_block (&body, fnbody); --- 2634,2640 ---- /* Emit a DECL_EXPR for this variable, which will cause the gimplifier to allocate storage, and all that good stuff. */ ! tmp = fold_build1 (DECL_EXPR, TREE_TYPE (decl), decl); gfc_add_expr_to_block (&body, tmp); gfc_add_expr_to_block (&body, fnbody); *************** gfc_trans_assign_aux_var (gfc_symbol * s *** 2446,2452 **** /* Set the initial value to length. See the comments in function gfc_add_assign_aux_vars in this file. */ ! gfc_add_modify_expr (&body, GFC_DECL_STRING_LEN (sym->backend_decl), build_int_cst (NULL_TREE, -2)); gfc_add_expr_to_block (&body, fnbody); --- 2653,2659 ---- /* Set the initial value to length. See the comments in function gfc_add_assign_aux_vars in this file. */ ! gfc_add_modify (&body, GFC_DECL_STRING_LEN (sym->backend_decl), build_int_cst (NULL_TREE, -2)); gfc_add_expr_to_block (&body, fnbody); *************** gfc_trans_vla_one_sizepos (tree *tp, stm *** 2477,2483 **** var = gfc_create_var_np (TREE_TYPE (t), NULL); gfc_add_decl_to_function (var); ! gfc_add_modify_expr (body, var, val); if (TREE_CODE (t) == SAVE_EXPR) TREE_OPERAND (t, 0) = var; *tp = var; --- 2684,2690 ---- var = gfc_create_var_np (TREE_TYPE (t), NULL); gfc_add_decl_to_function (var); ! gfc_add_modify (body, var, val); if (TREE_CODE (t) == SAVE_EXPR) TREE_OPERAND (t, 0) = var; *tp = var; *************** gfc_trans_deferred_vars (gfc_symbol * pr *** 2658,2665 **** if (el->sym != el->sym->result) break; } ! if (el == NULL) ! warning (0, "Function does not return a value"); } else if (proc_sym->as) { --- 2865,2874 ---- if (el->sym != el->sym->result) break; } ! /* TODO: move to the appropriate place in resolve.c. */ ! if (warn_return_type && el == NULL) ! gfc_warning ("Return value of function '%s' at %L not set", ! proc_sym->name, &proc_sym->declared_at); } else if (proc_sym->as) { *************** gfc_trans_deferred_vars (gfc_symbol * pr *** 2810,2815 **** --- 3019,3106 ---- return gfc_finish_block (&body); } + static GTY ((param_is (struct module_htab_entry))) htab_t module_htab; + + /* Hash and equality functions for module_htab. */ + + static hashval_t + module_htab_do_hash (const void *x) + { + return htab_hash_string (((const struct module_htab_entry *)x)->name); + } + + static int + module_htab_eq (const void *x1, const void *x2) + { + return strcmp ((((const struct module_htab_entry *)x1)->name), + (const char *)x2) == 0; + } + + /* Hash and equality functions for module_htab's decls. */ + + static hashval_t + module_htab_decls_hash (const void *x) + { + const_tree t = (const_tree) x; + const_tree n = DECL_NAME (t); + if (n == NULL_TREE) + n = TYPE_NAME (TREE_TYPE (t)); + return htab_hash_string (IDENTIFIER_POINTER (n)); + } + + static int + module_htab_decls_eq (const void *x1, const void *x2) + { + const_tree t1 = (const_tree) x1; + const_tree n1 = DECL_NAME (t1); + if (n1 == NULL_TREE) + n1 = TYPE_NAME (TREE_TYPE (t1)); + return strcmp (IDENTIFIER_POINTER (n1), (const char *) x2) == 0; + } + + struct module_htab_entry * + gfc_find_module (const char *name) + { + void **slot; + + if (! module_htab) + module_htab = htab_create_ggc (10, module_htab_do_hash, + module_htab_eq, NULL); + + slot = htab_find_slot_with_hash (module_htab, name, + htab_hash_string (name), INSERT); + if (*slot == NULL) + { + struct module_htab_entry *entry = GGC_CNEW (struct module_htab_entry); + + entry->name = gfc_get_string (name); + entry->decls = htab_create_ggc (10, module_htab_decls_hash, + module_htab_decls_eq, NULL); + *slot = (void *) entry; + } + return (struct module_htab_entry *) *slot; + } + + void + gfc_module_add_decl (struct module_htab_entry *entry, tree decl) + { + void **slot; + const char *name; + + if (DECL_NAME (decl)) + name = IDENTIFIER_POINTER (DECL_NAME (decl)); + else + { + gcc_assert (TREE_CODE (decl) == TYPE_DECL); + name = IDENTIFIER_POINTER (TYPE_NAME (TREE_TYPE (decl))); + } + slot = htab_find_slot_with_hash (entry->decls, name, + htab_hash_string (name), INSERT); + if (*slot == NULL) + *slot = (void *) decl; + } + + static struct module_htab_entry *cur_module; /* Output an initialized decl for a module variable. */ *************** gfc_create_module_variable (gfc_symbol * *** 2829,2841 **** && sym->ts.type == BT_DERIVED) sym->backend_decl = gfc_typenode_for_spec (&(sym->ts)); ! /* Only output variables and array valued, or derived type, ! parameters. */ if (sym->attr.flavor != FL_VARIABLE && !(sym->attr.flavor == FL_PARAMETER ! && (sym->attr.dimension || sym->ts.type == BT_DERIVED))) return; /* Don't generate variables from other modules. Variables from COMMONs will already have been generated. */ if (sym->attr.use_assoc || sym->attr.in_common) --- 3120,3158 ---- && sym->ts.type == BT_DERIVED) sym->backend_decl = gfc_typenode_for_spec (&(sym->ts)); ! if (sym->attr.flavor == FL_DERIVED ! && sym->backend_decl ! && TREE_CODE (sym->backend_decl) == RECORD_TYPE) ! { ! decl = sym->backend_decl; ! gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE); ! gcc_assert (TYPE_CONTEXT (decl) == NULL_TREE ! || TYPE_CONTEXT (decl) == sym->ns->proc_name->backend_decl); ! gcc_assert (DECL_CONTEXT (TYPE_STUB_DECL (decl)) == NULL_TREE ! || DECL_CONTEXT (TYPE_STUB_DECL (decl)) ! == sym->ns->proc_name->backend_decl); ! TYPE_CONTEXT (decl) = sym->ns->proc_name->backend_decl; ! DECL_CONTEXT (TYPE_STUB_DECL (decl)) = sym->ns->proc_name->backend_decl; ! gfc_module_add_decl (cur_module, TYPE_STUB_DECL (decl)); ! } ! ! /* Only output variables, procedure pointers and array valued, ! or derived type, parameters. */ if (sym->attr.flavor != FL_VARIABLE && !(sym->attr.flavor == FL_PARAMETER ! && (sym->attr.dimension || sym->ts.type == BT_DERIVED)) ! && !(sym->attr.flavor == FL_PROCEDURE && sym->attr.proc_pointer)) return; + if ((sym->attr.in_common || sym->attr.in_equivalence) && sym->backend_decl) + { + decl = sym->backend_decl; + gcc_assert (DECL_CONTEXT (decl) == NULL_TREE); + gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE); + DECL_CONTEXT (decl) = sym->ns->proc_name->backend_decl; + gfc_module_add_decl (cur_module, decl); + } + /* Don't generate variables from other modules. Variables from COMMONs will already have been generated. */ if (sym->attr.use_assoc || sym->attr.in_common) *************** gfc_create_module_variable (gfc_symbol * *** 2843,2850 **** /* Equivalenced variables arrive here after creation. */ if (sym->backend_decl ! && (sym->equiv_built || sym->attr.in_equivalence)) ! return; if (sym->backend_decl) internal_error ("backend decl for module variable %s already exists", --- 3160,3167 ---- /* Equivalenced variables arrive here after creation. */ if (sym->backend_decl ! && (sym->equiv_built || sym->attr.in_equivalence)) ! return; if (sym->backend_decl) internal_error ("backend decl for module variable %s already exists", *************** gfc_create_module_variable (gfc_symbol * *** 2857,2863 **** --- 3174,3184 ---- /* Create the variable. */ pushdecl (decl); + gcc_assert (DECL_CONTEXT (decl) == NULL_TREE); + gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE); + DECL_CONTEXT (decl) = sym->ns->proc_name->backend_decl; rest_of_decl_compilation (decl, 1, 0); + gfc_module_add_decl (cur_module, decl); /* Also add length of strings. */ if (sym->ts.type == BT_CHARACTER) *************** gfc_create_module_variable (gfc_symbol * *** 2873,2878 **** --- 3194,3408 ---- } } + /* Emit debug information for USE statements. */ + + static void + gfc_trans_use_stmts (gfc_namespace * ns) + { + gfc_use_list *use_stmt; + for (use_stmt = ns->use_stmts; use_stmt; use_stmt = use_stmt->next) + { + struct module_htab_entry *entry + = gfc_find_module (use_stmt->module_name); + gfc_use_rename *rent; + + if (entry->namespace_decl == NULL) + { + entry->namespace_decl + = build_decl (NAMESPACE_DECL, + get_identifier (use_stmt->module_name), + void_type_node); + DECL_EXTERNAL (entry->namespace_decl) = 1; + } + gfc_set_backend_locus (&use_stmt->where); + if (!use_stmt->only_flag) + (*debug_hooks->imported_module_or_decl) (entry->namespace_decl, + NULL_TREE, + ns->proc_name->backend_decl, + false); + for (rent = use_stmt->rename; rent; rent = rent->next) + { + tree decl, local_name; + void **slot; + + if (rent->op != INTRINSIC_NONE) + continue; + + slot = htab_find_slot_with_hash (entry->decls, rent->use_name, + htab_hash_string (rent->use_name), + INSERT); + if (*slot == NULL) + { + gfc_symtree *st; + + st = gfc_find_symtree (ns->sym_root, + rent->local_name[0] + ? rent->local_name : rent->use_name); + gcc_assert (st && st->n.sym->attr.use_assoc); + if (st->n.sym->backend_decl + && DECL_P (st->n.sym->backend_decl) + && st->n.sym->module + && 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)); + decl = copy_node (st->n.sym->backend_decl); + DECL_CONTEXT (decl) = entry->namespace_decl; + DECL_EXTERNAL (decl) = 1; + DECL_IGNORED_P (decl) = 0; + DECL_INITIAL (decl) = NULL_TREE; + } + else + { + *slot = error_mark_node; + htab_clear_slot (entry->decls, slot); + continue; + } + *slot = decl; + } + decl = (tree) *slot; + if (rent->local_name[0]) + local_name = get_identifier (rent->local_name); + else + local_name = NULL_TREE; + gfc_set_backend_locus (&rent->where); + (*debug_hooks->imported_module_or_decl) (decl, local_name, + ns->proc_name->backend_decl, + !use_stmt->only_flag); + } + } + } + + + /* Return true if expr is a constant initializer that gfc_conv_initializer + will handle. */ + + static bool + check_constant_initializer (gfc_expr *expr, gfc_typespec *ts, bool array, + bool pointer) + { + gfc_constructor *c; + gfc_component *cm; + + if (pointer) + return true; + else if (array) + { + if (expr->expr_type == EXPR_CONSTANT || expr->expr_type == EXPR_NULL) + return true; + else if (expr->expr_type == EXPR_STRUCTURE) + return check_constant_initializer (expr, ts, false, false); + else if (expr->expr_type != EXPR_ARRAY) + return false; + for (c = expr->value.constructor; c; c = c->next) + { + if (c->iterator) + return false; + if (c->expr->expr_type == EXPR_STRUCTURE) + { + if (!check_constant_initializer (c->expr, ts, false, false)) + return false; + } + else if (c->expr->expr_type != EXPR_CONSTANT) + return false; + } + return true; + } + else switch (ts->type) + { + case BT_DERIVED: + if (expr->expr_type != EXPR_STRUCTURE) + return false; + cm = expr->ts.derived->components; + for (c = expr->value.constructor; c; c = c->next, cm = cm->next) + { + if (!c->expr || cm->attr.allocatable) + continue; + if (!check_constant_initializer (c->expr, &cm->ts, + cm->attr.dimension, + cm->attr.pointer)) + return false; + } + return true; + default: + return expr->expr_type == EXPR_CONSTANT; + } + } + + /* Emit debug info for parameters and unreferenced variables with + initializers. */ + + static void + gfc_emit_parameter_debug_info (gfc_symbol *sym) + { + tree decl; + + if (sym->attr.flavor != FL_PARAMETER + && (sym->attr.flavor != FL_VARIABLE || sym->attr.referenced)) + return; + + if (sym->backend_decl != NULL + || sym->value == NULL + || sym->attr.use_assoc + || sym->attr.dummy + || sym->attr.result + || sym->attr.function + || sym->attr.intrinsic + || sym->attr.pointer + || sym->attr.allocatable + || sym->attr.cray_pointee + || sym->attr.threadprivate + || sym->attr.is_bind_c + || sym->attr.subref_array_pointer + || sym->attr.assign) + return; + + if (sym->ts.type == BT_CHARACTER) + { + gfc_conv_const_charlen (sym->ts.cl); + if (sym->ts.cl->backend_decl == NULL + || TREE_CODE (sym->ts.cl->backend_decl) != INTEGER_CST) + return; + } + else if (sym->ts.type == BT_DERIVED && sym->ts.derived->attr.alloc_comp) + return; + + if (sym->as) + { + int n; + + if (sym->as->type != AS_EXPLICIT) + return; + for (n = 0; n < sym->as->rank; n++) + if (sym->as->lower[n]->expr_type != EXPR_CONSTANT + || sym->as->upper[n] == NULL + || sym->as->upper[n]->expr_type != EXPR_CONSTANT) + return; + } + + if (!check_constant_initializer (sym->value, &sym->ts, + sym->attr.dimension, false)) + return; + + /* Create the decl for the variable or constant. */ + decl = build_decl (sym->attr.flavor == FL_PARAMETER ? CONST_DECL : VAR_DECL, + gfc_sym_identifier (sym), gfc_sym_type (sym)); + if (sym->attr.flavor == FL_PARAMETER) + TREE_READONLY (decl) = 1; + gfc_set_decl_location (decl, &sym->declared_at); + if (sym->attr.dimension) + GFC_DECL_PACKED_ARRAY (decl) = 1; + DECL_CONTEXT (decl) = sym->ns->proc_name->backend_decl; + TREE_STATIC (decl) = 1; + TREE_USED (decl) = 1; + if (DECL_CONTEXT (decl) && TREE_CODE (DECL_CONTEXT (decl)) == NAMESPACE_DECL) + TREE_PUBLIC (decl) = 1; + DECL_INITIAL (decl) + = gfc_conv_initializer (sym->value, &sym->ts, TREE_TYPE (decl), + sym->attr.dimension, 0); + debug_hooks->global_decl (decl); + } /* Generate all the required code for module variables. */ *************** void *** 2880,2885 **** --- 3410,3416 ---- gfc_generate_module_vars (gfc_namespace * ns) { module_namespace = ns; + cur_module = gfc_find_module (ns->proc_name->name); /* Check if the frontend left the namespace in a reasonable state. */ gcc_assert (ns->proc_name && !ns->proc_name->tlink); *************** gfc_generate_module_vars (gfc_namespace *** 2889,2896 **** --- 3420,3433 ---- /* Create decls for all the module variables. */ gfc_traverse_ns (ns, gfc_create_module_variable); + + cur_module = NULL; + + gfc_trans_use_stmts (ns); + gfc_traverse_ns (ns, gfc_emit_parameter_debug_info); } + static void gfc_generate_contained_functions (gfc_namespace * parent) { *************** generate_local_decl (gfc_symbol * sym) *** 2980,2990 **** { if (sym->attr.flavor == FL_VARIABLE) { - /* Check for dependencies in the array specification and string - length, adding the necessary declarations to the function. We - mark the symbol now, as well as in traverse_ns, to prevent - getting stuck in a circular dependency. */ - sym->mark = 1; if (!sym->attr.dummy && !sym->ns->proc_name->attr.entry_master) generate_dependency_declarations (sym); --- 3517,3522 ---- *************** generate_local_decl (gfc_symbol * sym) *** 3003,3020 **** /* Warn for unused variables, but not if they're inside a common block or are use-associated. */ else if (warn_unused_variable ! && !(sym->attr.in_common || sym->attr.use_assoc)) gfc_warning ("Unused variable '%s' declared at %L", sym->name, &sym->declared_at); /* For variable length CHARACTER parameters, the PARM_DECL already references the length variable, so force gfc_get_symbol_decl even when not referenced. If optimize > 0, it will be optimized away anyway. But do this only after emitting -Wunused-parameter warning if requested. */ ! if (sym->attr.dummy && ! sym->attr.referenced ! && sym->ts.type == BT_CHARACTER ! && sym->ts.cl->backend_decl != NULL ! && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL) { sym->attr.referenced = 1; gfc_get_symbol_decl (sym); --- 3535,3553 ---- /* Warn for unused variables, but not if they're inside a common block or are use-associated. */ else if (warn_unused_variable ! && !(sym->attr.in_common || sym->attr.use_assoc || sym->mark)) gfc_warning ("Unused variable '%s' declared at %L", sym->name, &sym->declared_at); + /* For variable length CHARACTER parameters, the PARM_DECL already references the length variable, so force gfc_get_symbol_decl even when not referenced. If optimize > 0, it will be optimized away anyway. But do this only after emitting -Wunused-parameter warning if requested. */ ! if (sym->attr.dummy && !sym->attr.referenced ! && sym->ts.type == BT_CHARACTER ! && sym->ts.cl->backend_decl != NULL ! && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL) { sym->attr.referenced = 1; gfc_get_symbol_decl (sym); *************** generate_local_decl (gfc_symbol * sym) *** 3033,3038 **** --- 3566,3577 ---- } + /* Check for dependencies in the array specification and string + length, adding the necessary declarations to the function. We + mark the symbol now, as well as in traverse_ns, to prevent + getting stuck in a circular dependency. */ + sym->mark = 1; + /* We do not want the middle-end to warn about unused parameters as this was already done above. */ if (sym->attr.dummy && sym->backend_decl != NULL_TREE) *************** generate_local_decl (gfc_symbol * sym) *** 3046,3051 **** --- 3585,3609 ---- gfc_warning ("Unused parameter '%s' declared at %L", sym->name, &sym->declared_at); } + else if (sym->attr.flavor == FL_PROCEDURE) + { + /* TODO: move to the appropriate place in resolve.c. */ + if (warn_return_type + && sym->attr.function + && sym->result + && sym != sym->result + && !sym->result->attr.referenced + && !sym->attr.use_assoc + && sym->attr.if_source != IFSRC_IFBODY) + { + gfc_warning ("Return value '%s' of function '%s' declared at " + "%L not set", sym->result->name, sym->name, + &sym->result->declared_at); + + /* Prevents "Unused variable" warning for RESULT variables. */ + sym->result->mark = 1; + } + } if (sym->attr.dummy == 1) { *************** gfc_generate_function_code (gfc_namespac *** 3148,3154 **** trans_function_start (sym); ! gfc_start_block (&block); if (ns->entries && ns->proc_name->ts.type == BT_CHARACTER) { --- 3706,3712 ---- trans_function_start (sym); ! gfc_init_block (&block); if (ns->entries && ns->proc_name->ts.type == BT_CHARACTER) { *************** gfc_generate_function_code (gfc_namespac *** 3223,3247 **** build_int_cst (integer_type_node, flag_bounds_check), array); array_type = build_array_type (integer_type_node, build_index_type (build_int_cst (NULL_TREE, ! 6))); array = build_constructor_from_list (array_type, nreverse (array)); TREE_CONSTANT (array) = 1; - TREE_INVARIANT (array) = 1; TREE_STATIC (array) = 1; /* Create a static variable to hold the jump table. */ var = gfc_create_var (array_type, "options"); TREE_CONSTANT (var) = 1; - TREE_INVARIANT (var) = 1; TREE_STATIC (var) = 1; TREE_READONLY (var) = 1; DECL_INITIAL (var) = array; var = gfc_build_addr_expr (pvoid_type_node, var); tmp = build_call_expr (gfor_fndecl_set_options, 2, ! build_int_cst (integer_type_node, 7), var); gfc_add_expr_to_block (&body, tmp); } --- 3781,3807 ---- build_int_cst (integer_type_node, flag_bounds_check), array); + array = tree_cons (NULL_TREE, + build_int_cst (integer_type_node, + gfc_option.flag_range_check), array); + array_type = build_array_type (integer_type_node, build_index_type (build_int_cst (NULL_TREE, ! 7))); array = build_constructor_from_list (array_type, nreverse (array)); TREE_CONSTANT (array) = 1; TREE_STATIC (array) = 1; /* Create a static variable to hold the jump table. */ var = gfc_create_var (array_type, "options"); TREE_CONSTANT (var) = 1; TREE_STATIC (var) = 1; TREE_READONLY (var) = 1; DECL_INITIAL (var) = array; var = gfc_build_addr_expr (pvoid_type_node, var); tmp = build_call_expr (gfor_fndecl_set_options, 2, ! build_int_cst (integer_type_node, 8), var); gfc_add_expr_to_block (&body, tmp); } *************** gfc_generate_function_code (gfc_namespac *** 3292,3298 **** { tree alternate_return; alternate_return = gfc_get_fake_result_decl (sym, 0); ! gfc_add_modify_expr (&body, alternate_return, integer_zero_node); } if (ns->entries) --- 3852,3858 ---- { tree alternate_return; alternate_return = gfc_get_fake_result_decl (sym, 0); ! gfc_add_modify (&body, alternate_return, integer_zero_node); } if (ns->entries) *************** gfc_generate_function_code (gfc_namespac *** 3339,3356 **** gfc_add_expr_to_block (&block, tmp2); } ! gfc_add_expr_to_block (&block, tmp); ! if (result == NULL_TREE) ! warning (0, "Function return value not set"); else { /* Set the return value to the dummy result variable. The types may be different for scalar default REAL functions with -ff2c, therefore we have to convert. */ tmp = convert (TREE_TYPE (DECL_RESULT (fndecl)), result); ! tmp = build2 (MODIFY_EXPR, TREE_TYPE (tmp), ! DECL_RESULT (fndecl), tmp); tmp = build1_v (RETURN_EXPR, tmp); gfc_add_expr_to_block (&block, tmp); } --- 3899,3923 ---- gfc_add_expr_to_block (&block, tmp2); } ! gfc_add_expr_to_block (&block, tmp); ! if (result == NULL_TREE) ! { ! /* TODO: move to the appropriate place in resolve.c. */ ! if (warn_return_type && !sym->attr.referenced && sym == sym->result) ! gfc_warning ("Return value of function '%s' at %L not set", ! sym->name, &sym->declared_at); ! ! TREE_NO_WARNING(sym->backend_decl) = 1; ! } else { /* Set the return value to the dummy result variable. The types may be different for scalar default REAL functions with -ff2c, therefore we have to convert. */ tmp = convert (TREE_TYPE (DECL_RESULT (fndecl)), result); ! tmp = fold_build2 (MODIFY_EXPR, TREE_TYPE (tmp), ! DECL_RESULT (fndecl), tmp); tmp = build1_v (RETURN_EXPR, tmp); gfc_add_expr_to_block (&block, tmp); } *************** gfc_generate_function_code (gfc_namespac *** 3373,3383 **** --- 3940,3955 ---- saved_function_decls = NULL_TREE; DECL_SAVED_TREE (fndecl) = gfc_finish_block (&block); + decl = getdecls (); /* Finish off this function and send it for code generation. */ poplevel (1, 0, 1); BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl; + DECL_SAVED_TREE (fndecl) + = build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (fndecl), + DECL_INITIAL (fndecl)); + /* Output the GENERIC tree. */ dump_function (TDI_original, fndecl); *************** gfc_generate_function_code (gfc_namespac *** 3406,3411 **** --- 3978,3986 ---- gfc_gimplify_function (fndecl); cgraph_finalize_function (fndecl, false); } + + gfc_trans_use_stmts (ns); + gfc_traverse_ns (ns, gfc_emit_parameter_debug_info); } void *************** gfc_generate_constructors (void) *** 3453,3461 **** --- 4028,4040 ---- DECL_SAVED_TREE (fndecl) = build_stmt (EXPR_STMT, tmp); } + decl = getdecls (); poplevel (1, 0, 1); BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl; + DECL_SAVED_TREE (fndecl) + = build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (fndecl), + DECL_INITIAL (fndecl)); free_after_parsing (cfun); free_after_compilation (cfun); *************** gfc_generate_block_data (gfc_namespace * *** 3497,3502 **** --- 4076,4082 ---- decl = build_decl (VAR_DECL, id, gfc_array_index_type); TREE_PUBLIC (decl) = 1; TREE_STATIC (decl) = 1; + DECL_IGNORED_P (decl) = 1; pushdecl (decl); rest_of_decl_compilation (decl, 1, 0); diff -Nrcpad gcc-4.3.3/gcc/fortran/trans-expr.c gcc-4.4.0/gcc/fortran/trans-expr.c *** gcc-4.3.3/gcc/fortran/trans-expr.c Sun Dec 21 15:06:15 2008 --- gcc-4.4.0/gcc/fortran/trans-expr.c Fri Feb 20 15:20:38 2009 *************** *** 1,6 **** /* Expression translation ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software ! Foundation, Inc. Contributed by Paul Brook and Steven Bosscher --- 1,6 ---- /* Expression translation ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 ! Free Software Foundation, Inc. Contributed by Paul Brook and Steven Bosscher *************** along with GCC; see the file COPYING3. *** 30,36 **** #include "ggc.h" #include "toplev.h" #include "real.h" ! #include "tree-gimple.h" #include "langhooks.h" #include "flags.h" #include "gfortran.h" --- 30,36 ---- #include "ggc.h" #include "toplev.h" #include "real.h" ! #include "gimple.h" #include "langhooks.h" #include "flags.h" #include "gfortran.h" *************** gfc_make_safe_expr (gfc_se * se) *** 115,121 **** /* We need a temporary for this result. */ var = gfc_create_var (TREE_TYPE (se->expr), NULL); ! gfc_add_modify_expr (&se->pre, var, se->expr); se->expr = var; } --- 115,121 ---- /* We need a temporary for this result. */ var = gfc_create_var (TREE_TYPE (se->expr), NULL); ! gfc_add_modify (&se->pre, var, se->expr); se->expr = var; } *************** gfc_conv_expr_present (gfc_symbol * sym) *** 139,146 **** || GFC_ARRAY_TYPE_P (TREE_TYPE (decl))); decl = GFC_DECL_SAVED_DESCRIPTOR (decl); } ! return build2 (NE_EXPR, boolean_type_node, decl, ! fold_convert (TREE_TYPE (decl), null_pointer_node)); } --- 139,146 ---- || GFC_ARRAY_TYPE_P (TREE_TYPE (decl))); decl = GFC_DECL_SAVED_DESCRIPTOR (decl); } ! return fold_build2 (NE_EXPR, boolean_type_node, decl, ! fold_convert (TREE_TYPE (decl), null_pointer_node)); } *************** gfc_conv_missing_dummy (gfc_se * se, gfc *** 161,167 **** tmp = fold_convert (tmp, build_fold_indirect_ref (se->expr)); /* Test for a NULL value. */ ! tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present, tmp, integer_one_node); tmp = gfc_evaluate_now (tmp, &se->pre); se->expr = build_fold_addr_expr (tmp); } --- 161,168 ---- tmp = fold_convert (tmp, build_fold_indirect_ref (se->expr)); /* Test for a NULL value. */ ! tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present, tmp, ! fold_convert (TREE_TYPE (tmp), integer_one_node)); tmp = gfc_evaluate_now (tmp, &se->pre); se->expr = build_fold_addr_expr (tmp); } *************** gfc_conv_missing_dummy (gfc_se * se, gfc *** 176,183 **** if (ts.type == BT_CHARACTER) { tmp = build_int_cst (gfc_charlen_type_node, 0); ! tmp = build3 (COND_EXPR, gfc_charlen_type_node, present, ! se->string_length, tmp); tmp = gfc_evaluate_now (tmp, &se->pre); se->string_length = tmp; } --- 177,184 ---- if (ts.type == BT_CHARACTER) { tmp = build_int_cst (gfc_charlen_type_node, 0); ! tmp = fold_build3 (COND_EXPR, gfc_charlen_type_node, ! present, se->string_length, tmp); tmp = gfc_evaluate_now (tmp, &se->pre); se->string_length = tmp; } *************** gfc_get_expr_charlen (gfc_expr *e) *** 240,263 **** return length; } ! /* Generate code to initialize a string length variable. Returns the ! value. */ void ! gfc_conv_string_length (gfc_charlen * cl, stmtblock_t * pblock) { gfc_se se; gfc_init_se (&se, NULL); gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node); se.expr = fold_build2 (MAX_EXPR, gfc_charlen_type_node, se.expr, build_int_cst (gfc_charlen_type_node, 0)); gfc_add_block_to_block (pblock, &se.pre); if (cl->backend_decl) ! gfc_add_modify_expr (pblock, cl->backend_decl, se.expr); else cl->backend_decl = gfc_evaluate_now (se.expr, pblock); } --- 241,349 ---- return length; } ! ! /* For each character array constructor subexpression without a ts.cl->length, ! replace it by its first element (if there aren't any elements, the length ! should already be set to zero). */ ! ! static void ! flatten_array_ctors_without_strlen (gfc_expr* e) ! { ! gfc_actual_arglist* arg; ! gfc_constructor* c; ! ! if (!e) ! return; ! ! switch (e->expr_type) ! { ! ! case EXPR_OP: ! flatten_array_ctors_without_strlen (e->value.op.op1); ! flatten_array_ctors_without_strlen (e->value.op.op2); ! break; ! ! case EXPR_COMPCALL: ! /* TODO: Implement as with EXPR_FUNCTION when needed. */ ! gcc_unreachable (); ! ! case EXPR_FUNCTION: ! for (arg = e->value.function.actual; arg; arg = arg->next) ! flatten_array_ctors_without_strlen (arg->expr); ! break; ! ! case EXPR_ARRAY: ! ! /* We've found what we're looking for. */ ! if (e->ts.type == BT_CHARACTER && !e->ts.cl->length) ! { ! gfc_expr* new_expr; ! gcc_assert (e->value.constructor); ! ! new_expr = e->value.constructor->expr; ! e->value.constructor->expr = NULL; ! ! flatten_array_ctors_without_strlen (new_expr); ! gfc_replace_expr (e, new_expr); ! break; ! } ! ! /* Otherwise, fall through to handle constructor elements. */ ! case EXPR_STRUCTURE: ! for (c = e->value.constructor; c; c = c->next) ! flatten_array_ctors_without_strlen (c->expr); ! break; ! ! default: ! break; ! ! } ! } ! /* Generate code to initialize a string length variable. Returns the ! value. For array constructors, cl->length might be NULL and in this case, ! the first element of the constructor is needed. expr is the original ! expression so we can access it but can be NULL if this is not needed. */ void ! gfc_conv_string_length (gfc_charlen * cl, gfc_expr * expr, stmtblock_t * pblock) { gfc_se se; gfc_init_se (&se, NULL); + + /* If cl->length is NULL, use gfc_conv_expr to obtain the string length but + "flatten" array constructors by taking their first element; all elements + should be the same length or a cl->length should be present. */ + if (!cl->length) + { + gfc_expr* expr_flat; + gcc_assert (expr); + + expr_flat = gfc_copy_expr (expr); + flatten_array_ctors_without_strlen (expr_flat); + gfc_resolve_expr (expr_flat); + + gfc_conv_expr (&se, expr_flat); + gfc_add_block_to_block (pblock, &se.pre); + cl->backend_decl = convert (gfc_charlen_type_node, se.string_length); + + gfc_free_expr (expr_flat); + return; + } + + /* Convert cl->length. */ + + gcc_assert (cl->length); + gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node); se.expr = fold_build2 (MAX_EXPR, gfc_charlen_type_node, se.expr, build_int_cst (gfc_charlen_type_node, 0)); gfc_add_block_to_block (pblock, &se.pre); if (cl->backend_decl) ! gfc_add_modify (pblock, cl->backend_decl, se.expr); else cl->backend_decl = gfc_evaluate_now (se.expr, pblock); } *************** gfc_conv_substring (gfc_se * se, gfc_ref *** 328,334 **** else asprintf (&msg, "Substring out of bounds: lower bound (%%ld)" "is less than one"); ! gfc_trans_runtime_check (fault, &se->pre, where, msg, fold_convert (long_integer_type_node, start.expr)); gfc_free (msg); --- 414,420 ---- else asprintf (&msg, "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, start.expr)); gfc_free (msg); *************** gfc_conv_substring (gfc_se * se, gfc_ref *** 344,350 **** else asprintf (&msg, "Substring out of bounds: upper bound (%%ld) " "exceeds string length (%%ld)"); ! gfc_trans_runtime_check (fault, &se->pre, where, msg, fold_convert (long_integer_type_node, end.expr), fold_convert (long_integer_type_node, se->string_length)); --- 430,436 ---- else asprintf (&msg, "Substring out of bounds: upper bound (%%ld) " "exceeds string length (%%ld)"); ! gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg, fold_convert (long_integer_type_node, end.expr), fold_convert (long_integer_type_node, se->string_length)); *************** gfc_conv_component_ref (gfc_se * se, gfc *** 378,384 **** field = c->backend_decl; gcc_assert (TREE_CODE (field) == FIELD_DECL); decl = se->expr; ! tmp = build3 (COMPONENT_REF, TREE_TYPE (field), decl, field, NULL_TREE); se->expr = tmp; --- 464,470 ---- field = c->backend_decl; gcc_assert (TREE_CODE (field) == FIELD_DECL); decl = se->expr; ! tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field), decl, field, NULL_TREE); se->expr = tmp; *************** gfc_conv_component_ref (gfc_se * se, gfc *** 390,400 **** se->string_length = tmp; } ! if (c->pointer && c->dimension == 0 && c->ts.type != BT_CHARACTER) se->expr = build_fold_indirect_ref (se->expr); } /* Return the contents of a variable. Also handles reference/pointer variables (all Fortran pointer references are implicit). */ --- 476,520 ---- se->string_length = tmp; } ! if (c->attr.pointer && c->attr.dimension == 0 && c->ts.type != BT_CHARACTER) se->expr = build_fold_indirect_ref (se->expr); } + /* This function deals with component references to components of the + parent type for derived type extensons. */ + static void + conv_parent_component_references (gfc_se * se, gfc_ref * ref) + { + gfc_component *c; + gfc_component *cmp; + gfc_symbol *dt; + gfc_ref parent; + + dt = ref->u.c.sym; + c = ref->u.c.component; + + /* Build a gfc_ref to recursively call gfc_conv_component_ref. */ + parent.type = REF_COMPONENT; + parent.next = NULL; + parent.u.c.sym = dt; + parent.u.c.component = dt->components; + + if (dt->attr.extension && dt->components) + { + /* Return if the component is not in the parent type. */ + for (cmp = dt->components->next; cmp; cmp = cmp->next) + if (strcmp (c->name, cmp->name) == 0) + return; + + /* Otherwise build the reference and call self. */ + gfc_conv_component_ref (se, &parent); + parent.u.c.sym = dt->components->ts.derived; + parent.u.c.component = c; + conv_parent_component_references (se, &parent); + } + } + /* Return the contents of a variable. Also handles reference/pointer variables (all Fortran pointer references are implicit). */ *************** gfc_conv_variable (gfc_se * se, gfc_expr *** 480,487 **** else if (sym->attr.flavor == FL_PROCEDURE && se->expr != current_function_decl) { ! gcc_assert (se->want_pointer); ! if (!sym->attr.dummy) { gcc_assert (TREE_CODE (se->expr) == FUNCTION_DECL); se->expr = build_fold_addr_expr (se->expr); --- 600,606 ---- else if (sym->attr.flavor == FL_PROCEDURE && se->expr != current_function_decl) { ! if (!sym->attr.dummy && !sym->attr.proc_pointer) { gcc_assert (TREE_CODE (se->expr) == FUNCTION_DECL); se->expr = build_fold_addr_expr (se->expr); *************** gfc_conv_variable (gfc_se * se, gfc_expr *** 513,519 **** /* Dereference scalar hidden result. */ if (gfc_option.flag_f2c && sym->ts.type == BT_COMPLEX && (sym->attr.function || sym->attr.result) ! && !sym->attr.dimension && !sym->attr.pointer) se->expr = build_fold_indirect_ref (se->expr); /* Dereference non-character pointer variables. --- 632,639 ---- /* Dereference scalar hidden result. */ if (gfc_option.flag_f2c && sym->ts.type == BT_COMPLEX && (sym->attr.function || sym->attr.result) ! && !sym->attr.dimension && !sym->attr.pointer ! && !sym->attr.always_explicit) se->expr = build_fold_indirect_ref (se->expr); /* Dereference non-character pointer variables. *************** gfc_conv_variable (gfc_se * se, gfc_expr *** 561,566 **** --- 681,689 ---- break; case REF_COMPONENT: + if (ref->u.c.sym->attr.extension) + conv_parent_component_references (se, ref); + gfc_conv_component_ref (se, ref); break; *************** gfc_conv_unary_op (enum tree_code code, *** 607,616 **** We must convert it to a compare to 0 (e.g. EQ_EXPR (op1, 0)). All other unary operators have an equivalent GIMPLE unary operator. */ if (code == TRUTH_NOT_EXPR) ! se->expr = build2 (EQ_EXPR, type, operand.expr, ! build_int_cst (type, 0)); else ! se->expr = build1 (code, type, operand.expr); } --- 730,739 ---- We must convert it to a compare to 0 (e.g. EQ_EXPR (op1, 0)). All other unary operators have an equivalent GIMPLE unary operator. */ if (code == TRUTH_NOT_EXPR) ! se->expr = fold_build2 (EQ_EXPR, type, operand.expr, ! build_int_cst (type, 0)); else ! se->expr = fold_build1 (code, type, operand.expr); } *************** gfc_conv_cst_int_power (gfc_se * se, tre *** 748,772 **** /* If rhs < 0 and lhs is an integer, the result is -1, 0 or 1. */ if ((sgn == -1) && (TREE_CODE (type) == INTEGER_TYPE)) { ! tmp = build2 (EQ_EXPR, boolean_type_node, lhs, ! build_int_cst (TREE_TYPE (lhs), -1)); ! cond = build2 (EQ_EXPR, boolean_type_node, lhs, ! build_int_cst (TREE_TYPE (lhs), 1)); /* If rhs is even, result = (lhs == 1 || lhs == -1) ? 1 : 0. */ if ((n & 1) == 0) { ! tmp = build2 (TRUTH_OR_EXPR, boolean_type_node, tmp, cond); ! se->expr = build3 (COND_EXPR, type, tmp, build_int_cst (type, 1), ! build_int_cst (type, 0)); return 1; } /* If rhs is odd, result = (lhs == 1) ? 1 : (lhs == -1) ? -1 : 0. */ ! tmp = build3 (COND_EXPR, type, tmp, build_int_cst (type, -1), ! build_int_cst (type, 0)); ! se->expr = build3 (COND_EXPR, type, cond, build_int_cst (type, 1), tmp); return 1; } --- 871,897 ---- /* If rhs < 0 and lhs is an integer, the result is -1, 0 or 1. */ if ((sgn == -1) && (TREE_CODE (type) == INTEGER_TYPE)) { ! tmp = fold_build2 (EQ_EXPR, boolean_type_node, ! lhs, build_int_cst (TREE_TYPE (lhs), -1)); ! cond = fold_build2 (EQ_EXPR, boolean_type_node, ! lhs, build_int_cst (TREE_TYPE (lhs), 1)); /* If rhs is even, result = (lhs == 1 || lhs == -1) ? 1 : 0. */ if ((n & 1) == 0) { ! tmp = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, tmp, cond); ! se->expr = fold_build3 (COND_EXPR, type, ! tmp, build_int_cst (type, 1), ! build_int_cst (type, 0)); return 1; } /* If rhs is odd, result = (lhs == 1) ? 1 : (lhs == -1) ? -1 : 0. */ ! tmp = fold_build3 (COND_EXPR, type, tmp, build_int_cst (type, -1), ! build_int_cst (type, 0)); ! se->expr = fold_build3 (COND_EXPR, type, ! cond, build_int_cst (type, 1), tmp); return 1; } *************** gfc_conv_cst_int_power (gfc_se * se, tre *** 775,781 **** if (sgn == -1) { tmp = gfc_build_const (type, integer_one_node); ! vartmp[1] = build2 (RDIV_EXPR, type, tmp, vartmp[1]); } se->expr = gfc_conv_powi (se, n, vartmp); --- 900,906 ---- if (sgn == -1) { tmp = gfc_build_const (type, integer_one_node); ! vartmp[1] = fold_build2 (RDIV_EXPR, type, tmp, vartmp[1]); } se->expr = gfc_conv_powi (se, n, vartmp); *************** gfc_conv_string_tmp (gfc_se * se, tree t *** 974,980 **** tmp = fold_build2 (MINUS_EXPR, gfc_charlen_type_node, len, build_int_cst (gfc_charlen_type_node, 1)); tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp); ! tmp = build_array_type (gfc_character1_type_node, tmp); var = gfc_create_var (tmp, "str"); var = gfc_build_addr_expr (type, var); } --- 1099,1110 ---- tmp = fold_build2 (MINUS_EXPR, gfc_charlen_type_node, len, build_int_cst (gfc_charlen_type_node, 1)); tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp); ! ! if (TREE_CODE (TREE_TYPE (type)) == ARRAY_TYPE) ! tmp = build_array_type (TREE_TYPE (TREE_TYPE (type)), tmp); ! else ! tmp = build_array_type (TREE_TYPE (type), tmp); ! var = gfc_create_var (tmp, "str"); var = gfc_build_addr_expr (type, var); } *************** gfc_conv_string_tmp (gfc_se * se, tree t *** 982,989 **** { /* Allocate a temporary to hold the result. */ var = gfc_create_var (type, "pstr"); ! tmp = gfc_call_malloc (&se->pre, type, len); ! gfc_add_modify_expr (&se->pre, var, tmp); /* Free the temporary afterwards. */ tmp = gfc_call_free (convert (pvoid_type_node, var)); --- 1112,1122 ---- { /* Allocate a temporary to hold the result. */ var = gfc_create_var (type, "pstr"); ! tmp = gfc_call_malloc (&se->pre, type, ! fold_build2 (MULT_EXPR, TREE_TYPE (len), len, ! fold_convert (TREE_TYPE (len), ! TYPE_SIZE (type)))); ! gfc_add_modify (&se->pre, var, tmp); /* Free the temporary afterwards. */ tmp = gfc_call_free (convert (pvoid_type_node, var)); *************** gfc_conv_string_tmp (gfc_se * se, tree t *** 1000,1014 **** static void gfc_conv_concat_op (gfc_se * se, gfc_expr * expr) { ! gfc_se lse; ! gfc_se rse; ! tree len; ! tree type; ! tree var; ! tree tmp; gcc_assert (expr->value.op.op1->ts.type == BT_CHARACTER ! && expr->value.op.op2->ts.type == BT_CHARACTER); gfc_init_se (&lse, se); gfc_conv_expr (&lse, expr->value.op.op1); --- 1133,1144 ---- static void gfc_conv_concat_op (gfc_se * se, gfc_expr * expr) { ! gfc_se lse, rse; ! tree len, type, var, tmp, fndecl; gcc_assert (expr->value.op.op1->ts.type == BT_CHARACTER ! && expr->value.op.op2->ts.type == BT_CHARACTER); ! gcc_assert (expr->value.op.op1->ts.kind == expr->value.op.op2->ts.kind); gfc_init_se (&lse, se); gfc_conv_expr (&lse, expr->value.op.op1); *************** gfc_conv_concat_op (gfc_se * se, gfc_exp *** 1033,1041 **** var = gfc_conv_string_tmp (se, type, len); /* Do the actual concatenation. */ ! tmp = build_call_expr (gfor_fndecl_concat_string, 6, ! len, var, ! lse.string_length, lse.expr, rse.string_length, rse.expr); gfc_add_expr_to_block (&se->pre, tmp); --- 1163,1176 ---- var = gfc_conv_string_tmp (se, type, len); /* Do the actual concatenation. */ ! if (expr->ts.kind == 1) ! fndecl = gfor_fndecl_concat_string; ! else if (expr->ts.kind == 4) ! fndecl = gfor_fndecl_concat_string_char4; ! else ! gcc_unreachable (); ! ! tmp = build_call_expr (fndecl, 6, len, var, lse.string_length, lse.expr, rse.string_length, rse.expr); gfc_add_expr_to_block (&se->pre, tmp); *************** gfc_conv_expr_op (gfc_se * se, gfc_expr *** 1067,1076 **** checkstring = 0; lop = 0; ! switch (expr->value.op.operator) { - case INTRINSIC_UPLUS: case INTRINSIC_PARENTHESES: gfc_conv_expr (se, expr->value.op.op1); return; --- 1202,1220 ---- checkstring = 0; lop = 0; ! switch (expr->value.op.op) { case INTRINSIC_PARENTHESES: + if (expr->ts.type == BT_REAL + || expr->ts.type == BT_COMPLEX) + { + gfc_conv_unary_op (PAREN_EXPR, se, expr); + gcc_assert (FLOAT_TYPE_P (TREE_TYPE (se->expr))); + return; + } + + /* Fallthrough. */ + case INTRINSIC_UPLUS: gfc_conv_expr (se, expr->value.op.op1); return; *************** gfc_conv_expr_op (gfc_se * se, gfc_expr *** 1200,1206 **** gfc_conv_string_parameter (&rse); lse.expr = gfc_build_compare_string (lse.string_length, lse.expr, ! rse.string_length, rse.expr); rse.expr = build_int_cst (TREE_TYPE (lse.expr), 0); gfc_add_block_to_block (&lse.post, &rse.post); } --- 1344,1351 ---- gfc_conv_string_parameter (&rse); lse.expr = gfc_build_compare_string (lse.string_length, lse.expr, ! rse.string_length, rse.expr, ! expr->value.op.op1->ts.kind); rse.expr = build_int_cst (TREE_TYPE (lse.expr), 0); gfc_add_block_to_block (&lse.post, &rse.post); } *************** gfc_conv_expr_op (gfc_se * se, gfc_expr *** 1224,1237 **** /* If a string's length is one, we convert it to a single character. */ static tree ! gfc_to_single_character (tree len, tree str) { gcc_assert (POINTER_TYPE_P (TREE_TYPE (str))); if (INTEGER_CST_P (len) && TREE_INT_CST_LOW (len) == 1 ! && TREE_INT_CST_HIGH (len) == 0) { ! str = fold_convert (pchar_type_node, str); return build_fold_indirect_ref (str); } --- 1369,1382 ---- /* If a string's length is one, we convert it to a single character. */ static tree ! string_to_single_character (tree len, tree str, int kind) { gcc_assert (POINTER_TYPE_P (TREE_TYPE (str))); if (INTEGER_CST_P (len) && TREE_INT_CST_LOW (len) == 1 ! && TREE_INT_CST_HIGH (len) == 0) { ! str = fold_convert (gfc_get_pchar_type (kind), str); return build_fold_indirect_ref (str); } *************** gfc_conv_scalar_char_value (gfc_symbol * *** 1263,1268 **** --- 1408,1414 ---- if ((*expr)->expr_type == EXPR_CONSTANT) { gfc_typespec ts; + gfc_clear_ts (&ts); *expr = gfc_int_expr ((int)(*expr)->value.character.string[0]); if ((*expr)->ts.kind != gfc_c_int_kind) *************** gfc_conv_scalar_char_value (gfc_symbol * *** 1278,1295 **** { if ((*expr)->ref == NULL) { ! se->expr = gfc_to_single_character (build_int_cst (integer_type_node, 1), ! gfc_build_addr_expr (pchar_type_node, gfc_get_symbol_decl ! ((*expr)->symtree->n.sym))); } else { gfc_conv_variable (se, *expr); ! se->expr = gfc_to_single_character (build_int_cst (integer_type_node, 1), ! gfc_build_addr_expr (pchar_type_node, se->expr)); } } } --- 1424,1444 ---- { if ((*expr)->ref == NULL) { ! se->expr = string_to_single_character (build_int_cst (integer_type_node, 1), ! gfc_build_addr_expr (gfc_get_pchar_type ((*expr)->ts.kind), gfc_get_symbol_decl ! ((*expr)->symtree->n.sym)), ! (*expr)->ts.kind); } else { gfc_conv_variable (se, *expr); ! se->expr = string_to_single_character (build_int_cst (integer_type_node, 1), ! gfc_build_addr_expr (gfc_get_pchar_type ((*expr)->ts.kind), ! se->expr), ! (*expr)->ts.kind); } } } *************** gfc_conv_scalar_char_value (gfc_symbol * *** 1300,1306 **** subtraction of them. Otherwise, we build a library call. */ tree ! gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2) { tree sc1; tree sc2; --- 1449,1455 ---- subtraction of them. Otherwise, we build a library call. */ tree ! gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2, int kind) { tree sc1; tree sc2; *************** gfc_build_compare_string (tree len1, tre *** 1309,1328 **** gcc_assert (POINTER_TYPE_P (TREE_TYPE (str1))); gcc_assert (POINTER_TYPE_P (TREE_TYPE (str2))); ! sc1 = gfc_to_single_character (len1, str1); ! sc2 = gfc_to_single_character (len2, str2); - /* Deal with single character specially. */ if (sc1 != NULL_TREE && sc2 != NULL_TREE) { sc1 = fold_convert (integer_type_node, sc1); sc2 = fold_convert (integer_type_node, sc2); tmp = fold_build2 (MINUS_EXPR, integer_type_node, sc1, sc2); } ! else ! /* Build a call for the comparison. */ ! tmp = build_call_expr (gfor_fndecl_compare_string, 4, ! len1, str1, len2, str2); return tmp; } --- 1458,1488 ---- gcc_assert (POINTER_TYPE_P (TREE_TYPE (str1))); gcc_assert (POINTER_TYPE_P (TREE_TYPE (str2))); ! sc1 = string_to_single_character (len1, str1, kind); ! sc2 = string_to_single_character (len2, str2, kind); if (sc1 != NULL_TREE && sc2 != NULL_TREE) { + /* Deal with single character specially. */ sc1 = fold_convert (integer_type_node, sc1); sc2 = fold_convert (integer_type_node, sc2); tmp = fold_build2 (MINUS_EXPR, integer_type_node, sc1, sc2); } ! else ! { ! /* Build a call for the comparison. */ ! tree fndecl; ! ! if (kind == 1) ! fndecl = gfor_fndecl_compare_string; ! else if (kind == 4) ! fndecl = gfor_fndecl_compare_string_char4; ! else ! gcc_unreachable (); ! ! tmp = build_call_expr (fndecl, 4, len1, str1, len2, str2); ! } ! return tmp; } *************** gfc_conv_function_val (gfc_se * se, gfc_ *** 1334,1339 **** --- 1494,1501 ---- if (sym->attr.dummy) { tmp = gfc_get_symbol_decl (sym); + if (sym->attr.proc_pointer) + tmp = build_fold_indirect_ref (tmp); gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == POINTER_TYPE && TREE_CODE (TREE_TYPE (TREE_TYPE (tmp))) == FUNCTION_TYPE); } *************** gfc_conv_function_val (gfc_se * se, gfc_ *** 1343,1351 **** sym->backend_decl = gfc_get_extern_function_decl (sym); tmp = sym->backend_decl; if (sym->attr.cray_pointee) ! tmp = convert (build_pointer_type (TREE_TYPE (tmp)), ! gfc_get_symbol_decl (sym->cp_pointer)); if (!POINTER_TYPE_P (TREE_TYPE (tmp))) { gcc_assert (TREE_CODE (tmp) == FUNCTION_DECL); --- 1505,1521 ---- sym->backend_decl = gfc_get_extern_function_decl (sym); tmp = sym->backend_decl; + if (sym->attr.cray_pointee) ! { ! /* TODO - make the cray pointee a pointer to a procedure, ! assign the pointer to it and use it for the call. This ! will do for now! */ ! tmp = convert (build_pointer_type (TREE_TYPE (tmp)), ! gfc_get_symbol_decl (sym->cp_pointer)); ! tmp = gfc_evaluate_now (tmp, &se->pre); ! } ! if (!POINTER_TYPE_P (TREE_TYPE (tmp))) { gcc_assert (TREE_CODE (tmp) == FUNCTION_DECL); *************** gfc_free_interface_mapping (gfc_interfac *** 1421,1430 **** for (sym = mapping->syms; sym; sym = nextsym) { nextsym = sym->next; ! sym->new->n.sym->formal = NULL; ! gfc_free_symbol (sym->new->n.sym); gfc_free_expr (sym->expr); ! gfc_free (sym->new); gfc_free (sym); } for (cl = mapping->charlens; cl; cl = nextcl) --- 1591,1600 ---- for (sym = mapping->syms; sym; sym = nextsym) { nextsym = sym->next; ! sym->new_sym->n.sym->formal = NULL; ! gfc_free_symbol (sym->new_sym->n.sym); gfc_free_expr (sym->expr); ! gfc_free (sym->new_sym); gfc_free (sym); } for (cl = mapping->charlens; cl; cl = nextcl) *************** static gfc_charlen * *** 1443,1456 **** gfc_get_interface_mapping_charlen (gfc_interface_mapping * mapping, gfc_charlen * cl) { ! gfc_charlen *new; ! new = gfc_get_charlen (); ! new->next = mapping->charlens; ! new->length = gfc_copy_expr (cl->length); ! mapping->charlens = new; ! return new; } --- 1613,1626 ---- gfc_get_interface_mapping_charlen (gfc_interface_mapping * mapping, gfc_charlen * cl) { ! gfc_charlen *new_charlen; ! new_charlen = gfc_get_charlen (); ! new_charlen->next = mapping->charlens; ! new_charlen->length = gfc_copy_expr (cl->length); ! mapping->charlens = new_charlen; ! return new_charlen; } *************** gfc_get_interface_mapping_array (stmtblo *** 1471,1477 **** type = gfc_get_nodesc_array_type (type, sym->as, packed); var = gfc_create_var (type, "ifm"); ! gfc_add_modify_expr (block, var, fold_convert (type, data)); return var; } --- 1641,1647 ---- type = gfc_get_nodesc_array_type (type, sym->as, packed); var = gfc_create_var (type, "ifm"); ! gfc_add_modify (block, var, fold_convert (type, data)); return var; } *************** gfc_add_interface_mapping (gfc_interface *** 1566,1575 **** gcc_assert (new_symtree == root); /* Create a dummy->actual mapping. */ ! sm = gfc_getmem (sizeof (*sm)); sm->next = mapping->syms; sm->old = sym; ! sm->new = new_symtree; sm->expr = gfc_copy_expr (expr); mapping->syms = sm; --- 1736,1745 ---- gcc_assert (new_symtree == root); /* Create a dummy->actual mapping. */ ! sm = XCNEW (gfc_interface_sym_mapping); sm->next = mapping->syms; sm->old = sym; ! sm->new_sym = new_symtree; sm->expr = gfc_copy_expr (expr); mapping->syms = sm; *************** gfc_finish_interface_mapping (gfc_interf *** 1661,1670 **** gfc_se se; for (sym = mapping->syms; sym; sym = sym->next) ! if (sym->new->n.sym->ts.type == BT_CHARACTER ! && !sym->new->n.sym->ts.cl->backend_decl) { ! expr = sym->new->n.sym->ts.cl->length; gfc_apply_interface_mapping_to_expr (mapping, expr); gfc_init_se (&se, NULL); gfc_conv_expr (&se, expr); --- 1831,1840 ---- gfc_se se; for (sym = mapping->syms; sym; sym = sym->next) ! if (sym->new_sym->n.sym->ts.type == BT_CHARACTER ! && !sym->new_sym->n.sym->ts.cl->backend_decl) { ! expr = sym->new_sym->n.sym->ts.cl->length; gfc_apply_interface_mapping_to_expr (mapping, expr); gfc_init_se (&se, NULL); gfc_conv_expr (&se, expr); *************** gfc_finish_interface_mapping (gfc_interf *** 1673,1679 **** gfc_add_block_to_block (pre, &se.pre); gfc_add_block_to_block (post, &se.post); ! sym->new->n.sym->ts.cl->backend_decl = se.expr; } } --- 1843,1849 ---- gfc_add_block_to_block (pre, &se.pre); gfc_add_block_to_block (post, &se.post); ! sym->new_sym->n.sym->ts.cl->backend_decl = se.expr; } } *************** gfc_map_intrinsic_function (gfc_expr *ex *** 1760,1767 **** case GFC_ISYM_LEN: /* TODO figure out why this condition is necessary. */ if (sym->attr.function ! && arg1->ts.cl->length->expr_type != EXPR_CONSTANT ! && arg1->ts.cl->length->expr_type != EXPR_VARIABLE) return false; new_expr = gfc_copy_expr (arg1->ts.cl->length); --- 1930,1938 ---- case GFC_ISYM_LEN: /* TODO figure out why this condition is necessary. */ if (sym->attr.function ! && (arg1->ts.cl->length == NULL ! || (arg1->ts.cl->length->expr_type != EXPR_CONSTANT ! && arg1->ts.cl->length->expr_type != EXPR_VARIABLE))) return false; new_expr = gfc_copy_expr (arg1->ts.cl->length); *************** gfc_apply_interface_mapping_to_expr (gfc *** 1913,1924 **** /* ...and to the expression's symbol, if it has one. */ /* TODO Find out why the condition on expr->symtree had to be moved into ! the loop rather than being ouside it, as originally. */ for (sym = mapping->syms; sym; sym = sym->next) if (expr->symtree && sym->old == expr->symtree->n.sym) { ! if (sym->new->n.sym->backend_decl) ! expr->symtree = sym->new; else if (sym->expr) gfc_replace_expr (expr, gfc_copy_expr (sym->expr)); } --- 2084,2095 ---- /* ...and to the expression's symbol, if it has one. */ /* TODO Find out why the condition on expr->symtree had to be moved into ! the loop rather than being outside it, as originally. */ for (sym = mapping->syms; sym; sym = sym->next) if (expr->symtree && sym->old == expr->symtree->n.sym) { ! if (sym->new_sym->n.sym->backend_decl) ! expr->symtree = sym->new_sym; else if (sym->expr) gfc_replace_expr (expr, gfc_copy_expr (sym->expr)); } *************** gfc_apply_interface_mapping_to_expr (gfc *** 1950,1958 **** for (sym = mapping->syms; sym; sym = sym->next) if (sym->old == expr->value.function.esym) { ! expr->value.function.esym = sym->new->n.sym; gfc_map_fcn_formal_to_actual (expr, sym->expr, mapping); ! expr->value.function.esym->result = sym->new->n.sym; } break; --- 2121,2129 ---- for (sym = mapping->syms; sym; sym = sym->next) if (sym->old == expr->value.function.esym) { ! expr->value.function.esym = sym->new_sym->n.sym; gfc_map_fcn_formal_to_actual (expr, sym->expr, mapping); ! expr->value.function.esym->result = sym->new_sym->n.sym; } break; *************** gfc_apply_interface_mapping_to_expr (gfc *** 1960,1965 **** --- 2131,2140 ---- case EXPR_STRUCTURE: gfc_apply_interface_mapping_to_cons (mapping, expr->value.constructor); break; + + case EXPR_COMPCALL: + gcc_unreachable (); + break; } return; *************** gfc_conv_subref_array_arg (gfc_se * parm *** 2021,2027 **** /* Build an ss for the temporary. */ if (expr->ts.type == BT_CHARACTER && !expr->ts.cl->backend_decl) ! gfc_conv_string_length (expr->ts.cl, &parmse->pre); base_type = gfc_typenode_for_spec (&expr->ts); if (GFC_ARRAY_TYPE_P (base_type) --- 2196,2202 ---- /* Build an ss for the temporary. */ if (expr->ts.type == BT_CHARACTER && !expr->ts.cl->backend_decl) ! gfc_conv_string_length (expr->ts.cl, expr, &parmse->pre); base_type = gfc_typenode_for_spec (&expr->ts); if (GFC_ARRAY_TYPE_P (base_type) *************** gfc_conv_subref_array_arg (gfc_se * parm *** 2045,2051 **** gfc_add_ss_to_loop (&loop, loop.temp_ss); /* Setup the scalarizing loops. */ ! gfc_conv_loop_setup (&loop); /* Pass the temporary descriptor back to the caller. */ info = &loop.temp_ss->data.info; --- 2220,2226 ---- gfc_add_ss_to_loop (&loop, loop.temp_ss); /* Setup the scalarizing loops. */ ! gfc_conv_loop_setup (&loop, &expr->where); /* Pass the temporary descriptor back to the caller. */ info = &loop.temp_ss->data.info; *************** gfc_conv_subref_array_arg (gfc_se * parm *** 2110,2116 **** gfc_conv_ss_startstride (&loop2); /* Setup the scalarizing loops. */ ! gfc_conv_loop_setup (&loop2); gfc_copy_loopinfo_to_se (&lse, &loop2); gfc_copy_loopinfo_to_se (&rse, &loop2); --- 2285,2291 ---- gfc_conv_ss_startstride (&loop2); /* Setup the scalarizing loops. */ ! gfc_conv_loop_setup (&loop2, &expr->where); gfc_copy_loopinfo_to_se (&lse, &loop2); gfc_copy_loopinfo_to_se (&rse, &loop2); *************** gfc_conv_subref_array_arg (gfc_se * parm *** 2151,2157 **** tmp_index = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp_index, rse.loop->from[0]); ! gfc_add_modify_expr (&rse.loop->code[0], offset, tmp_index); tmp_index = fold_build2 (PLUS_EXPR, gfc_array_index_type, rse.loop->loopvar[0], offset); --- 2326,2332 ---- tmp_index = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp_index, rse.loop->from[0]); ! gfc_add_modify (&rse.loop->code[0], offset, tmp_index); tmp_index = fold_build2 (PLUS_EXPR, gfc_array_index_type, rse.loop->loopvar[0], offset); *************** gfc_conv_function_call (gfc_se * se, gfc *** 2263,2268 **** --- 2438,2444 ---- stringargs = NULL_TREE; var = NULL_TREE; len = NULL_TREE; + gfc_clear_ts (&ts); if (sym->from_intmod == INTMOD_ISO_C_BINDING) { *************** gfc_conv_function_call (gfc_se * se, gfc *** 2284,2290 **** f = f || !sym->attr.always_explicit; argss = gfc_walk_expr (arg->expr); ! gfc_conv_array_parameter (se, arg->expr, argss, f, NULL); } /* TODO -- the following two lines shouldn't be necessary, but --- 2460,2466 ---- f = f || !sym->attr.always_explicit; argss = gfc_walk_expr (arg->expr); ! gfc_conv_array_parameter (se, arg->expr, argss, f, NULL, NULL); } /* TODO -- the following two lines shouldn't be necessary, but *************** gfc_conv_function_call (gfc_se * se, gfc *** 2305,2310 **** --- 2481,2514 ---- return 0; } + else if ((sym->intmod_sym_id == ISOCBINDING_F_POINTER + && arg->next->expr->rank == 0) + || sym->intmod_sym_id == ISOCBINDING_F_PROCPOINTER) + { + /* Convert c_f_pointer if fptr is a scalar + and convert c_f_procpointer. */ + gfc_se cptrse; + gfc_se fptrse; + + gfc_init_se (&cptrse, NULL); + gfc_conv_expr (&cptrse, arg->expr); + gfc_add_block_to_block (&se->pre, &cptrse.pre); + gfc_add_block_to_block (&se->post, &cptrse.post); + + gfc_init_se (&fptrse, NULL); + if (sym->intmod_sym_id == ISOCBINDING_F_POINTER) + fptrse.want_pointer = 1; + + gfc_conv_expr (&fptrse, arg->next->expr); + gfc_add_block_to_block (&se->pre, &fptrse.pre); + gfc_add_block_to_block (&se->post, &fptrse.post); + + tmp = arg->next->expr->symtree->n.sym->backend_decl; + se->expr = fold_build2 (MODIFY_EXPR, TREE_TYPE (tmp), fptrse.expr, + fold_convert (TREE_TYPE (tmp), cptrse.expr)); + + return 0; + } else if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED) { gfc_se arg1se; *************** gfc_conv_function_call (gfc_se * se, gfc *** 2322,2330 **** if (arg->next == NULL) /* Only given one arg so generate a null and do a not-equal comparison against the first arg. */ ! se->expr = build2 (NE_EXPR, boolean_type_node, arg1se.expr, ! fold_convert (TREE_TYPE (arg1se.expr), ! null_pointer_node)); else { tree eq_expr; --- 2526,2534 ---- if (arg->next == NULL) /* Only given one arg so generate a null and do a not-equal comparison against the first arg. */ ! se->expr = fold_build2 (NE_EXPR, boolean_type_node, arg1se.expr, ! fold_convert (TREE_TYPE (arg1se.expr), ! null_pointer_node)); else { tree eq_expr; *************** gfc_conv_function_call (gfc_se * se, gfc *** 2337,2352 **** gfc_add_block_to_block (&se->post, &arg2se.post); /* Generate test to compare that the two args are equal. */ ! eq_expr = build2 (EQ_EXPR, boolean_type_node, arg1se.expr, ! arg2se.expr); /* Generate test to ensure that the first arg is not null. */ ! not_null_expr = build2 (NE_EXPR, boolean_type_node, arg1se.expr, ! null_pointer_node); /* Finally, the generated test must check that both arg1 is not NULL and that it is equal to the second arg. */ ! se->expr = build2 (TRUTH_AND_EXPR, boolean_type_node, ! not_null_expr, eq_expr); } return 0; --- 2541,2556 ---- gfc_add_block_to_block (&se->post, &arg2se.post); /* Generate test to compare that the two args are equal. */ ! eq_expr = fold_build2 (EQ_EXPR, boolean_type_node, ! arg1se.expr, arg2se.expr); /* Generate test to ensure that the first arg is not null. */ ! not_null_expr = fold_build2 (NE_EXPR, boolean_type_node, ! arg1se.expr, null_pointer_node); /* Finally, the generated test must check that both arg1 is not NULL and that it is equal to the second arg. */ ! se->expr = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, ! not_null_expr, eq_expr); } return 0; *************** gfc_conv_function_call (gfc_se * se, gfc *** 2427,2433 **** if (argss == gfc_ss_terminator) { ! if (fsym && fsym->attr.value) { if (fsym->ts.type == BT_CHARACTER && fsym->ts.is_c_interop --- 2631,2648 ---- if (argss == gfc_ss_terminator) { ! if (e->expr_type == EXPR_VARIABLE ! && e->symtree->n.sym->attr.cray_pointee ! && fsym && fsym->attr.flavor == FL_PROCEDURE) ! { ! /* The Cray pointer needs to be converted to a pointer to ! a type given by the expression. */ ! gfc_conv_expr (&parmse, e); ! type = build_pointer_type (TREE_TYPE (parmse.expr)); ! tmp = gfc_get_symbol_decl (e->symtree->n.sym->cp_pointer); ! parmse.expr = convert (type, tmp); ! } ! else if (fsym && fsym->attr.value) { if (fsym->ts.type == BT_CHARACTER && fsym->ts.is_c_interop *************** gfc_conv_function_call (gfc_se * se, gfc *** 2456,2464 **** else { gfc_conv_expr_reference (&parmse, e); ! if (fsym && fsym->attr.pointer ! && fsym->attr.flavor != FL_PROCEDURE ! && e->expr_type != EXPR_NULL) { /* Scalar pointer dummy args require an extra level of indirection. The null pointer already contains --- 2671,2680 ---- else { gfc_conv_expr_reference (&parmse, e); ! if (fsym && e->expr_type != EXPR_NULL ! && ((fsym->attr.pointer ! && fsym->attr.flavor != FL_PROCEDURE) ! || fsym->attr.proc_pointer)) { /* Scalar pointer dummy args require an extra level of indirection. The null pointer already contains *************** gfc_conv_function_call (gfc_se * se, gfc *** 2491,2497 **** gfc_conv_subref_array_arg (&parmse, e, f, fsym ? fsym->attr.intent : INTENT_INOUT); else ! gfc_conv_array_parameter (&parmse, e, argss, f, fsym); /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is allocated on entry, it must be deallocated. */ --- 2707,2714 ---- gfc_conv_subref_array_arg (&parmse, e, f, fsym ? fsym->attr.intent : INTENT_INOUT); else ! gfc_conv_array_parameter (&parmse, e, argss, f, fsym, ! sym->name); /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is allocated on entry, it must be deallocated. */ *************** gfc_conv_function_call (gfc_se * se, gfc *** 2529,2535 **** && parmse.string_length == NULL_TREE && e->ts.type == BT_PROCEDURE && e->symtree->n.sym->ts.type == BT_CHARACTER ! && e->symtree->n.sym->ts.cl->length != NULL) { gfc_conv_const_charlen (e->symtree->n.sym->ts.cl); parmse.string_length = e->symtree->n.sym->ts.cl->backend_decl; --- 2746,2753 ---- && parmse.string_length == NULL_TREE && e->ts.type == BT_PROCEDURE && e->symtree->n.sym->ts.type == BT_CHARACTER ! && e->symtree->n.sym->ts.cl->length != NULL ! && e->symtree->n.sym->ts.cl->length->expr_type == EXPR_CONSTANT) { gfc_conv_const_charlen (e->symtree->n.sym->ts.cl); parmse.string_length = e->symtree->n.sym->ts.cl->backend_decl; *************** gfc_conv_function_call (gfc_se * se, gfc *** 2578,2584 **** gfc_finish_interface_mapping (&mapping, &se->pre, &se->post); ts = sym->ts; ! if (ts.type == BT_CHARACTER && !sym->attr.is_bind_c) { if (sym->ts.cl->length == NULL) { --- 2796,2804 ---- gfc_finish_interface_mapping (&mapping, &se->pre, &se->post); ts = sym->ts; ! if (ts.type == BT_CHARACTER && sym->attr.is_bind_c) ! se->string_length = build_int_cst (gfc_charlen_type_node, 1); ! else if (ts.type == BT_CHARACTER) { if (sym->ts.cl->length == NULL) { *************** gfc_conv_function_call (gfc_se * se, gfc *** 2630,2636 **** { if (se->direct_byref) { ! /* Sometimes, too much indirection can be applied; eg. for function_result = array_valued_recursive_function. */ if (TREE_TYPE (TREE_TYPE (se->expr)) && TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr))) --- 2850,2856 ---- { if (se->direct_byref) { ! /* Sometimes, too much indirection can be applied; e.g. for function_result = array_valued_recursive_function. */ if (TREE_TYPE (TREE_TYPE (se->expr)) && TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr))) *************** gfc_conv_function_call (gfc_se * se, gfc *** 2656,2662 **** mustn't be deallocated. */ callee_alloc = sym->attr.allocatable || sym->attr.pointer; gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp, ! false, !sym->attr.pointer, callee_alloc); /* Pass the temporary as the first argument. */ tmp = info->descriptor; --- 2876,2883 ---- mustn't be deallocated. */ callee_alloc = sym->attr.allocatable || sym->attr.pointer; gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp, ! NULL_TREE, false, !sym->attr.pointer, ! callee_alloc, &se->ss->expr->where); /* Pass the temporary as the first argument. */ tmp = info->descriptor; *************** gfc_conv_function_call (gfc_se * se, gfc *** 2774,2780 **** tmp = gfc_conv_descriptor_data_get (info->descriptor); tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp, info->data); ! gfc_trans_runtime_check (tmp, &se->pre, NULL, gfc_msg_fault); } se->expr = info->descriptor; /* Bundle in the string length. */ --- 2995,3002 ---- tmp = gfc_conv_descriptor_data_get (info->descriptor); tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp, info->data); ! gfc_trans_runtime_check (true, false, tmp, &se->pre, NULL, ! gfc_msg_fault); } se->expr = info->descriptor; /* Bundle in the string length. */ *************** gfc_conv_function_call (gfc_se * se, gfc *** 2808,2818 **** } /* Generate code to copy a string. */ void gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest, ! tree slength, tree src) { tree tmp, dlen, slen; tree dsc; --- 3030,3106 ---- } + /* Fill a character string with spaces. */ + + static tree + fill_with_spaces (tree start, tree type, tree size) + { + stmtblock_t block, loop; + tree i, el, exit_label, cond, tmp; + + /* For a simple char type, we can call memset(). */ + if (compare_tree_int (TYPE_SIZE_UNIT (type), 1) == 0) + return build_call_expr (built_in_decls[BUILT_IN_MEMSET], 3, start, + build_int_cst (gfc_get_int_type (gfc_c_int_kind), + lang_hooks.to_target_charset (' ')), + size); + + /* Otherwise, we use a loop: + for (el = start, i = size; i > 0; el--, i+= TYPE_SIZE_UNIT (type)) + *el = (type) ' '; + */ + + /* Initialize variables. */ + gfc_init_block (&block); + i = gfc_create_var (sizetype, "i"); + gfc_add_modify (&block, i, fold_convert (sizetype, size)); + el = gfc_create_var (build_pointer_type (type), "el"); + gfc_add_modify (&block, el, fold_convert (TREE_TYPE (el), start)); + exit_label = gfc_build_label_decl (NULL_TREE); + TREE_USED (exit_label) = 1; + + + /* Loop body. */ + gfc_init_block (&loop); + + /* Exit condition. */ + cond = fold_build2 (LE_EXPR, boolean_type_node, i, + fold_convert (sizetype, integer_zero_node)); + tmp = build1_v (GOTO_EXPR, exit_label); + tmp = fold_build3 (COND_EXPR, void_type_node, cond, tmp, build_empty_stmt ()); + gfc_add_expr_to_block (&loop, tmp); + + /* Assignment. */ + gfc_add_modify (&loop, fold_build1 (INDIRECT_REF, type, el), + build_int_cst (type, + lang_hooks.to_target_charset (' '))); + + /* Increment loop variables. */ + gfc_add_modify (&loop, i, fold_build2 (MINUS_EXPR, sizetype, i, + TYPE_SIZE_UNIT (type))); + gfc_add_modify (&loop, el, fold_build2 (POINTER_PLUS_EXPR, + TREE_TYPE (el), el, + TYPE_SIZE_UNIT (type))); + + /* Making the loop... actually loop! */ + tmp = gfc_finish_block (&loop); + tmp = build1_v (LOOP_EXPR, tmp); + gfc_add_expr_to_block (&block, tmp); + + /* The exit label. */ + tmp = build1_v (LABEL_EXPR, exit_label); + gfc_add_expr_to_block (&block, tmp); + + + return gfc_finish_block (&block); + } + + /* Generate code to copy a string. */ void gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest, ! int dkind, tree slength, tree src, int skind) { tree tmp, dlen, slen; tree dsc; *************** gfc_trans_string_copy (stmtblock_t * blo *** 2822,2833 **** tree tmp2; tree tmp3; tree tmp4; stmtblock_t tempblock; if (slength != NULL_TREE) { slen = fold_convert (size_type_node, gfc_evaluate_now (slength, block)); ! ssc = gfc_to_single_character (slen, src); } else { --- 3110,3124 ---- tree tmp2; tree tmp3; tree tmp4; + tree chartype; stmtblock_t tempblock; + gcc_assert (dkind == skind); + if (slength != NULL_TREE) { slen = fold_convert (size_type_node, gfc_evaluate_now (slength, block)); ! ssc = string_to_single_character (slen, src, skind); } else { *************** gfc_trans_string_copy (stmtblock_t * blo *** 2838,2844 **** if (dlength != NULL_TREE) { dlen = fold_convert (size_type_node, gfc_evaluate_now (dlength, block)); ! dsc = gfc_to_single_character (slen, dest); } else { --- 3129,3135 ---- if (dlength != NULL_TREE) { dlen = fold_convert (size_type_node, gfc_evaluate_now (dlength, block)); ! dsc = string_to_single_character (slen, dest, dkind); } else { *************** gfc_trans_string_copy (stmtblock_t * blo *** 2847,2862 **** } if (slength != NULL_TREE && POINTER_TYPE_P (TREE_TYPE (src))) ! ssc = gfc_to_single_character (slen, src); if (dlength != NULL_TREE && POINTER_TYPE_P (TREE_TYPE (dest))) ! dsc = gfc_to_single_character (dlen, dest); /* Assign directly if the types are compatible. */ if (dsc != NULL_TREE && ssc != NULL_TREE ! && TREE_TYPE (dsc) == TREE_TYPE (ssc)) { ! gfc_add_modify_expr (block, dsc, ssc); return; } --- 3138,3153 ---- } if (slength != NULL_TREE && POINTER_TYPE_P (TREE_TYPE (src))) ! ssc = string_to_single_character (slen, src, skind); if (dlength != NULL_TREE && POINTER_TYPE_P (TREE_TYPE (dest))) ! dsc = string_to_single_character (dlen, dest, dkind); /* Assign directly if the types are compatible. */ if (dsc != NULL_TREE && ssc != NULL_TREE ! && TREE_TYPE (dsc) == TREE_TYPE (ssc)) { ! gfc_add_modify (block, dsc, ssc); return; } *************** gfc_trans_string_copy (stmtblock_t * blo *** 2887,2892 **** --- 3178,3193 ---- 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); + slen = fold_build2 (MULT_EXPR, size_type_node, + fold_convert (size_type_node, slen), + fold_convert (size_type_node, TYPE_SIZE_UNIT (chartype))); + dlen = fold_build2 (MULT_EXPR, size_type_node, + fold_convert (size_type_node, dlen), + fold_convert (size_type_node, TYPE_SIZE_UNIT (chartype))); + if (dlength) dest = fold_convert (pvoid_type_node, dest); else *************** gfc_trans_string_copy (stmtblock_t * blo *** 2908,2919 **** tmp4 = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (dest), dest, fold_convert (sizetype, slen)); ! tmp4 = build_call_expr (built_in_decls[BUILT_IN_MEMSET], 3, ! tmp4, ! build_int_cst (gfc_get_int_type (gfc_c_int_kind), ! lang_hooks.to_target_charset (' ')), ! fold_build2 (MINUS_EXPR, TREE_TYPE(dlen), ! dlen, slen)); gfc_init_block (&tempblock); gfc_add_expr_to_block (&tempblock, tmp3); --- 3209,3217 ---- tmp4 = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (dest), dest, fold_convert (sizetype, slen)); ! tmp4 = fill_with_spaces (tmp4, chartype, ! fold_build2 (MINUS_EXPR, TREE_TYPE(dlen), ! dlen, slen)); gfc_init_block (&tempblock); gfc_add_expr_to_block (&tempblock, tmp3); *************** gfc_conv_statement_function (gfc_se * se *** 2975,2981 **** tree arglen; gcc_assert (fsym->ts.cl && fsym->ts.cl->length ! && fsym->ts.cl->length->expr_type == EXPR_CONSTANT); arglen = TYPE_MAX_VALUE (TYPE_DOMAIN (type)); tmp = gfc_build_addr_expr (build_pointer_type (type), --- 3273,3279 ---- tree arglen; gcc_assert (fsym->ts.cl && fsym->ts.cl->length ! && fsym->ts.cl->length->expr_type == EXPR_CONSTANT); arglen = TYPE_MAX_VALUE (TYPE_DOMAIN (type)); tmp = gfc_build_addr_expr (build_pointer_type (type), *************** gfc_conv_statement_function (gfc_se * se *** 2986,2993 **** gfc_add_block_to_block (&se->pre, &lse.pre); gfc_add_block_to_block (&se->pre, &rse.pre); ! gfc_trans_string_copy (&se->pre, arglen, tmp, rse.string_length, ! rse.expr); gfc_add_block_to_block (&se->pre, &lse.post); gfc_add_block_to_block (&se->pre, &rse.post); } --- 3284,3291 ---- gfc_add_block_to_block (&se->pre, &lse.pre); gfc_add_block_to_block (&se->pre, &rse.pre); ! gfc_trans_string_copy (&se->pre, arglen, tmp, fsym->ts.kind, ! rse.string_length, rse.expr, fsym->ts.kind); gfc_add_block_to_block (&se->pre, &lse.post); gfc_add_block_to_block (&se->pre, &rse.post); } *************** gfc_conv_statement_function (gfc_se * se *** 2997,3003 **** gfc_conv_expr (&lse, args->expr); gfc_add_block_to_block (&se->pre, &lse.pre); ! gfc_add_modify_expr (&se->pre, temp_vars[n], lse.expr); gfc_add_block_to_block (&se->pre, &lse.post); } --- 3295,3301 ---- gfc_conv_expr (&lse, args->expr); gfc_add_block_to_block (&se->pre, &lse.pre); ! gfc_add_modify (&se->pre, temp_vars[n], lse.expr); gfc_add_block_to_block (&se->pre, &lse.post); } *************** gfc_conv_statement_function (gfc_se * se *** 3023,3029 **** tmp = gfc_create_var (type, sym->name); tmp = gfc_build_addr_expr (build_pointer_type (type), tmp); gfc_trans_string_copy (&se->pre, sym->ts.cl->backend_decl, tmp, ! se->string_length, se->expr); se->expr = tmp; } se->string_length = sym->ts.cl->backend_decl; --- 3321,3328 ---- tmp = gfc_create_var (type, sym->name); tmp = gfc_build_addr_expr (build_pointer_type (type), tmp); gfc_trans_string_copy (&se->pre, sym->ts.cl->backend_decl, tmp, ! sym->ts.kind, se->string_length, se->expr, ! sym->ts.kind); se->expr = tmp; } se->string_length = sym->ts.cl->backend_decl; *************** gfc_trans_subarray_assign (tree dest, gf *** 3199,3205 **** gfc_conv_ss_startstride (&loop); /* Setup the scalarizing loops. */ ! gfc_conv_loop_setup (&loop); /* Setup the gfc_se structures. */ gfc_copy_loopinfo_to_se (&lse, &loop); --- 3498,3504 ---- gfc_conv_ss_startstride (&loop); /* Setup the scalarizing loops. */ ! gfc_conv_loop_setup (&loop, &expr->where); /* Setup the gfc_se structures. */ gfc_copy_loopinfo_to_se (&lse, &loop); *************** gfc_trans_subcomponent_assign (tree dest *** 3256,3266 **** gfc_start_block (&block); ! if (cm->pointer) { gfc_init_se (&se, NULL); /* Pointer component. */ ! if (cm->dimension) { /* Array pointer. */ if (expr->expr_type == EXPR_NULL) --- 3555,3565 ---- gfc_start_block (&block); ! if (cm->attr.pointer) { gfc_init_se (&se, NULL); /* Pointer component. */ ! if (cm->attr.dimension) { /* Array pointer. */ if (expr->expr_type == EXPR_NULL) *************** gfc_trans_subcomponent_assign (tree dest *** 3281,3296 **** se.want_pointer = 1; gfc_conv_expr (&se, expr); gfc_add_block_to_block (&block, &se.pre); ! gfc_add_modify_expr (&block, dest, fold_convert (TREE_TYPE (dest), se.expr)); gfc_add_block_to_block (&block, &se.post); } } ! else if (cm->dimension) { ! if (cm->allocatable && expr->expr_type == EXPR_NULL) gfc_conv_descriptor_data_set (&block, dest, null_pointer_node); ! else if (cm->allocatable) { tree tmp2; --- 3580,3595 ---- se.want_pointer = 1; gfc_conv_expr (&se, expr); gfc_add_block_to_block (&block, &se.pre); ! gfc_add_modify (&block, dest, fold_convert (TREE_TYPE (dest), se.expr)); gfc_add_block_to_block (&block, &se.post); } } ! else if (cm->attr.dimension) { ! if (cm->attr.allocatable && expr->expr_type == EXPR_NULL) gfc_conv_descriptor_data_set (&block, dest, null_pointer_node); ! else if (cm->attr.allocatable) { tree tmp2; *************** gfc_trans_subcomponent_assign (tree dest *** 3302,3308 **** gfc_add_block_to_block (&block, &se.pre); tmp = fold_convert (TREE_TYPE (dest), se.expr); ! gfc_add_modify_expr (&block, dest, tmp); if (cm->ts.type == BT_DERIVED && cm->ts.derived->attr.alloc_comp) tmp = gfc_copy_alloc_comp (cm->ts.derived, se.expr, dest, --- 3601,3607 ---- gfc_add_block_to_block (&block, &se.pre); tmp = fold_convert (TREE_TYPE (dest), se.expr); ! gfc_add_modify (&block, dest, tmp); if (cm->ts.type == BT_DERIVED && cm->ts.derived->attr.alloc_comp) tmp = gfc_copy_alloc_comp (cm->ts.derived, se.expr, dest, *************** gfc_trans_subcomponent_assign (tree dest *** 3321,3327 **** /* Shift the lbound and ubound of temporaries to being unity, rather than zero, based. Calculate the offset for all cases. */ offset = gfc_conv_descriptor_offset (dest); ! gfc_add_modify_expr (&block, offset, gfc_index_zero_node); tmp2 =gfc_create_var (gfc_array_index_type, NULL); for (n = 0; n < expr->rank; n++) { --- 3620,3626 ---- /* Shift the lbound and ubound of temporaries to being unity, rather than zero, based. Calculate the offset for all cases. */ offset = gfc_conv_descriptor_offset (dest); ! gfc_add_modify (&block, offset, gfc_index_zero_node); tmp2 =gfc_create_var (gfc_array_index_type, NULL); for (n = 0; n < expr->rank; n++) { *************** gfc_trans_subcomponent_assign (tree dest *** 3332,3352 **** tmp = gfc_conv_descriptor_ubound (dest, gfc_rank_cst[n]); span = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp, gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n])); ! gfc_add_modify_expr (&block, tmp, fold_build2 (PLUS_EXPR, gfc_array_index_type, span, gfc_index_one_node)); tmp = gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]); ! gfc_add_modify_expr (&block, tmp, gfc_index_one_node); } tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]), gfc_conv_descriptor_stride (dest, gfc_rank_cst[n])); ! gfc_add_modify_expr (&block, tmp2, tmp); tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp2); ! gfc_add_modify_expr (&block, offset, tmp); } if (expr->expr_type == EXPR_FUNCTION --- 3631,3651 ---- tmp = gfc_conv_descriptor_ubound (dest, gfc_rank_cst[n]); span = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp, gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n])); ! gfc_add_modify (&block, tmp, fold_build2 (PLUS_EXPR, gfc_array_index_type, span, gfc_index_one_node)); tmp = gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]); ! gfc_add_modify (&block, tmp, gfc_index_one_node); } tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]), gfc_conv_descriptor_stride (dest, gfc_rank_cst[n])); ! gfc_add_modify (&block, tmp2, tmp); tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp2); ! gfc_add_modify (&block, offset, tmp); } if (expr->expr_type == EXPR_FUNCTION *************** gfc_trans_subcomponent_assign (tree dest *** 3390,3399 **** { gfc_init_se (&se, NULL); gfc_conv_expr (&se, expr); ! gfc_add_block_to_block (&block, &se.pre); ! gfc_add_modify_expr (&block, dest, fold_convert (TREE_TYPE (dest), se.expr)); ! gfc_add_block_to_block (&block, &se.post); } else { --- 3689,3698 ---- { gfc_init_se (&se, NULL); gfc_conv_expr (&se, expr); ! gfc_add_block_to_block (&block, &se.pre); ! gfc_add_modify (&block, dest, fold_convert (TREE_TYPE (dest), se.expr)); ! gfc_add_block_to_block (&block, &se.post); } else { *************** gfc_trans_structure_assign (tree dest, g *** 3438,3444 **** continue; field = cm->backend_decl; ! tmp = build3 (COMPONENT_REF, TREE_TYPE (field), dest, field, NULL_TREE); tmp = gfc_trans_subcomponent_assign (tmp, cm, c->expr); gfc_add_expr_to_block (&block, tmp); } --- 3737,3744 ---- continue; field = cm->backend_decl; ! tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field), ! dest, field, NULL_TREE); tmp = gfc_trans_subcomponent_assign (tmp, cm, c->expr); gfc_add_expr_to_block (&block, tmp); } *************** gfc_conv_structure (gfc_se * se, gfc_exp *** 3479,3499 **** components. Although the latter have a default initializer of EXPR_NULL,... by default, the static nullify is not needed since this is done every time we come into scope. */ ! if (!c->expr || cm->allocatable) continue; val = gfc_conv_initializer (c->expr, &cm->ts, ! TREE_TYPE (cm->backend_decl), cm->dimension, cm->pointer); /* Append it to the constructor list. */ CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, val); } se->expr = build_constructor (type, v); if (init) ! { ! TREE_CONSTANT(se->expr) = 1; ! TREE_INVARIANT(se->expr) = 1; ! } } --- 3779,3796 ---- components. Although the latter have a default initializer of EXPR_NULL,... by default, the static nullify is not needed since this is done every time we come into scope. */ ! if (!c->expr || cm->attr.allocatable) continue; val = gfc_conv_initializer (c->expr, &cm->ts, ! TREE_TYPE (cm->backend_decl), cm->attr.dimension, cm->attr.pointer); /* Append it to the constructor list. */ CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, val); } se->expr = build_constructor (type, v); if (init) ! TREE_CONSTANT (se->expr) = 1; } *************** gfc_conv_substring_expr (gfc_se * se, gf *** 3508,3515 **** gcc_assert (ref == NULL || ref->type == REF_SUBSTRING); ! se->expr = gfc_build_string_const (expr->value.character.length, ! expr->value.character.string); se->string_length = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (se->expr))); TYPE_STRING_FLAG (TREE_TYPE (se->expr)) = 1; --- 3805,3814 ---- gcc_assert (ref == NULL || ref->type == REF_SUBSTRING); ! se->expr = gfc_build_wide_string_const (expr->ts.kind, ! expr->value.character.length, ! expr->value.character.string); ! se->string_length = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (se->expr))); TYPE_STRING_FLAG (TREE_TYPE (se->expr)) = 1; *************** gfc_conv_expr_val (gfc_se * se, gfc_expr *** 3625,3631 **** if (se->post.head) { val = gfc_create_var (TREE_TYPE (se->expr), NULL); ! gfc_add_modify_expr (&se->pre, val, se->expr); se->expr = val; gfc_add_block_to_block (&se->pre, &se->post); } --- 3924,3930 ---- if (se->post.head) { val = gfc_create_var (TREE_TYPE (se->expr), NULL); ! gfc_add_modify (&se->pre, val, se->expr); se->expr = val; gfc_add_block_to_block (&se->pre, &se->post); } *************** gfc_conv_expr_reference (gfc_se * se, gf *** 3671,3677 **** if (se->post.head) { var = gfc_create_var (TREE_TYPE (se->expr), NULL); ! gfc_add_modify_expr (&se->pre, var, se->expr); gfc_add_block_to_block (&se->pre, &se->post); se->expr = var; } --- 3970,3976 ---- if (se->post.head) { var = gfc_create_var (TREE_TYPE (se->expr), NULL); ! gfc_add_modify (&se->pre, var, se->expr); gfc_add_block_to_block (&se->pre, &se->post); se->expr = var; } *************** gfc_conv_expr_reference (gfc_se * se, gf *** 3685,3691 **** se->want_pointer = 1; gfc_conv_expr (se, expr); var = gfc_create_var (TREE_TYPE (se->expr), NULL); ! gfc_add_modify_expr (&se->pre, var, se->expr); se->expr = var; return; } --- 3984,3990 ---- se->want_pointer = 1; gfc_conv_expr (se, expr); var = gfc_create_var (TREE_TYPE (se->expr), NULL); ! gfc_add_modify (&se->pre, var, se->expr); se->expr = var; return; } *************** gfc_conv_expr_reference (gfc_se * se, gf *** 3706,3712 **** else { var = gfc_create_var (TREE_TYPE (se->expr), NULL); ! gfc_add_modify_expr (&se->pre, var, se->expr); } gfc_add_block_to_block (&se->pre, &se->post); --- 4005,4011 ---- else { var = gfc_create_var (TREE_TYPE (se->expr), NULL); ! gfc_add_modify (&se->pre, var, se->expr); } gfc_add_block_to_block (&se->pre, &se->post); *************** gfc_trans_pointer_assignment (gfc_expr * *** 3736,3742 **** tree tmp; tree decl; - gfc_start_block (&block); gfc_init_se (&lse, NULL); --- 4035,4040 ---- *************** gfc_trans_pointer_assignment (gfc_expr * *** 3752,3768 **** gfc_init_se (&rse, NULL); rse.want_pointer = 1; gfc_conv_expr (&rse, expr2); gfc_add_block_to_block (&block, &lse.pre); gfc_add_block_to_block (&block, &rse.pre); ! gfc_add_modify_expr (&block, lse.expr, fold_convert (TREE_TYPE (lse.expr), rse.expr)); gfc_add_block_to_block (&block, &rse.post); gfc_add_block_to_block (&block, &lse.post); } else { /* Array pointer. */ gfc_conv_expr_descriptor (&lse, expr1, lss); switch (expr2->expr_type) { case EXPR_NULL: --- 4050,4088 ---- gfc_init_se (&rse, NULL); rse.want_pointer = 1; gfc_conv_expr (&rse, expr2); + + if (expr1->symtree->n.sym->attr.proc_pointer + && expr1->symtree->n.sym->attr.dummy) + lse.expr = build_fold_indirect_ref (lse.expr); + gfc_add_block_to_block (&block, &lse.pre); gfc_add_block_to_block (&block, &rse.pre); ! ! /* Check character lengths if character expression. The test is only ! really added if -fbounds-check is enabled. */ ! if (expr1->ts.type == BT_CHARACTER && expr2->expr_type != EXPR_NULL) ! { ! gcc_assert (expr2->ts.type == BT_CHARACTER); ! gcc_assert (lse.string_length && rse.string_length); ! gfc_trans_same_strlen_check ("pointer assignment", &expr1->where, ! lse.string_length, rse.string_length, ! &block); ! } ! ! gfc_add_modify (&block, lse.expr, fold_convert (TREE_TYPE (lse.expr), rse.expr)); + gfc_add_block_to_block (&block, &rse.post); gfc_add_block_to_block (&block, &lse.post); } else { + tree strlen_lhs; + tree strlen_rhs = NULL_TREE; + /* Array pointer. */ gfc_conv_expr_descriptor (&lse, expr1, lss); + strlen_lhs = lse.string_length; switch (expr2->expr_type) { case EXPR_NULL: *************** gfc_trans_pointer_assignment (gfc_expr * *** 3772,3779 **** case EXPR_VARIABLE: /* Assign directly to the pointer's descriptor. */ ! lse.direct_byref = 1; gfc_conv_expr_descriptor (&lse, expr2, rss); /* If this is a subreference array pointer assignment, use the rhs descriptor element size for the lhs span. */ --- 4092,4100 ---- case EXPR_VARIABLE: /* Assign directly to the pointer's descriptor. */ ! lse.direct_byref = 1; gfc_conv_expr_descriptor (&lse, expr2, rss); + strlen_rhs = lse.string_length; /* If this is a subreference array pointer assignment, use the rhs descriptor element size for the lhs span. */ *************** gfc_trans_pointer_assignment (gfc_expr * *** 3786,3793 **** 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_expr (&lse.post, GFC_DECL_SPAN(decl), tmp); } break; --- 4107,4114 ---- 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); } break; *************** gfc_trans_pointer_assignment (gfc_expr * *** 3801,3810 **** lse.expr = tmp; lse.direct_byref = 1; gfc_conv_expr_descriptor (&lse, expr2, rss); ! gfc_add_modify_expr (&lse.pre, desc, tmp); break; ! } gfc_add_block_to_block (&block, &lse.pre); gfc_add_block_to_block (&block, &lse.post); } return gfc_finish_block (&block); --- 4122,4144 ---- lse.expr = tmp; lse.direct_byref = 1; gfc_conv_expr_descriptor (&lse, expr2, rss); ! strlen_rhs = lse.string_length; ! gfc_add_modify (&lse.pre, desc, tmp); break; ! } ! gfc_add_block_to_block (&block, &lse.pre); + + /* Check string lengths if applicable. The check is only really added + to the output code if -fbounds-check is enabled. */ + if (expr1->ts.type == BT_CHARACTER && expr2->expr_type != EXPR_NULL) + { + gcc_assert (expr2->ts.type == BT_CHARACTER); + gcc_assert (strlen_lhs && strlen_rhs); + gfc_trans_same_strlen_check ("pointer assignment", &expr1->where, + strlen_lhs, strlen_rhs, &block); + } + gfc_add_block_to_block (&block, &lse.post); } return gfc_finish_block (&block); *************** gfc_trans_pointer_assignment (gfc_expr * *** 3812,3818 **** /* Makes sure se is suitable for passing as a function string parameter. */ ! /* TODO: Need to check all callers fo this function. It may be abused. */ void gfc_conv_string_parameter (gfc_se * se) --- 4146,4152 ---- /* Makes sure se is suitable for passing as a function string parameter. */ ! /* TODO: Need to check all callers of this function. It may be abused. */ void gfc_conv_string_parameter (gfc_se * se) *************** gfc_conv_string_parameter (gfc_se * se) *** 3821,3835 **** if (TREE_CODE (se->expr) == STRING_CST) { ! se->expr = gfc_build_addr_expr (pchar_type_node, se->expr); return; } ! type = TREE_TYPE (se->expr); ! if (TYPE_STRING_FLAG (type)) { if (TREE_CODE (se->expr) != INDIRECT_REF) ! se->expr = gfc_build_addr_expr (pchar_type_node, se->expr); else { type = gfc_get_character_type_len (gfc_default_character_kind, --- 4155,4172 ---- if (TREE_CODE (se->expr) == STRING_CST) { ! type = TREE_TYPE (TREE_TYPE (se->expr)); ! se->expr = gfc_build_addr_expr (build_pointer_type (type), se->expr); return; } ! if (TYPE_STRING_FLAG (TREE_TYPE (se->expr))) { if (TREE_CODE (se->expr) != INDIRECT_REF) ! { ! type = TREE_TYPE (se->expr); ! se->expr = gfc_build_addr_expr (build_pointer_type (type), se->expr); ! } else { type = gfc_get_character_type_len (gfc_default_character_kind, *************** gfc_trans_scalar_assign (gfc_se * lse, g *** 3878,3884 **** rlen = rse->string_length; } ! gfc_trans_string_copy (&block, llen, lse->expr, rlen, rse->expr); } else if (ts.type == BT_DERIVED && ts.derived->attr.alloc_comp) { --- 4215,4222 ---- rlen = rse->string_length; } ! gfc_trans_string_copy (&block, llen, lse->expr, ts.kind, rlen, ! rse->expr, ts.kind); } else if (ts.type == BT_DERIVED && ts.derived->attr.alloc_comp) { *************** gfc_trans_scalar_assign (gfc_se * lse, g *** 3909,3915 **** gfc_add_block_to_block (&block, &rse->pre); gfc_add_block_to_block (&block, &lse->pre); ! gfc_add_modify_expr (&block, lse->expr, fold_convert (TREE_TYPE (lse->expr), rse->expr)); /* Do a deep copy if the rhs is a variable, if it is not the --- 4247,4253 ---- gfc_add_block_to_block (&block, &rse->pre); gfc_add_block_to_block (&block, &lse->pre); ! gfc_add_modify (&block, lse->expr, fold_convert (TREE_TYPE (lse->expr), rse->expr)); /* Do a deep copy if the rhs is a variable, if it is not the *************** gfc_trans_scalar_assign (gfc_se * lse, g *** 3926,3932 **** gfc_add_block_to_block (&block, &lse->pre); gfc_add_block_to_block (&block, &rse->pre); ! gfc_add_modify_expr (&block, lse->expr, fold_convert (TREE_TYPE (lse->expr), rse->expr)); } --- 4264,4270 ---- gfc_add_block_to_block (&block, &lse->pre); gfc_add_block_to_block (&block, &rse->pre); ! gfc_add_modify (&block, lse->expr, fold_convert (TREE_TYPE (lse->expr), rse->expr)); } *************** gfc_trans_arrayfunc_assign (gfc_expr * e *** 4017,4023 **** gfc_start_block (&se.pre); se.want_pointer = 1; ! gfc_conv_array_parameter (&se, expr1, ss, 0, NULL); se.direct_byref = 1; se.ss = gfc_walk_expr (expr2); --- 4355,4361 ---- gfc_start_block (&se.pre); se.want_pointer = 1; ! gfc_conv_array_parameter (&se, expr1, ss, 0, NULL, NULL); se.direct_byref = 1; se.ss = gfc_walk_expr (expr2); *************** gfc_trans_zero_assign (gfc_expr * expr) *** 4109,4115 **** /* Helper for gfc_trans_array_copy and gfc_trans_array_constructor_copy that constructs the call to __builtin_memcpy. */ ! static tree gfc_build_memcpy_call (tree dst, tree src, tree len) { tree tmp; --- 4447,4453 ---- /* Helper for gfc_trans_array_copy and gfc_trans_array_constructor_copy that constructs the call to __builtin_memcpy. */ ! tree gfc_build_memcpy_call (tree dst, tree src, tree len) { tree tmp; *************** gfc_trans_assignment_1 (gfc_expr * expr1 *** 4291,4297 **** /* Resolve any data dependencies in the statement. */ gfc_conv_resolve_dependencies (&loop, lss, rss); /* Setup the scalarizing loops. */ ! gfc_conv_loop_setup (&loop); /* Setup the gfc_se structures. */ gfc_copy_loopinfo_to_se (&lse, &loop); --- 4629,4635 ---- /* Resolve any data dependencies in the statement. */ gfc_conv_resolve_dependencies (&loop, lss, rss); /* Setup the scalarizing loops. */ ! gfc_conv_loop_setup (&loop, &expr2->where); /* Setup the gfc_se structures. */ gfc_copy_loopinfo_to_se (&lse, &loop); diff -Nrcpad gcc-4.3.3/gcc/fortran/trans-intrinsic.c gcc-4.4.0/gcc/fortran/trans-intrinsic.c *** gcc-4.3.3/gcc/fortran/trans-intrinsic.c Sun Jul 27 11:41:35 2008 --- gcc-4.4.0/gcc/fortran/trans-intrinsic.c Fri Feb 20 15:20:38 2009 *************** *** 1,5 **** /* Intrinsic translation ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook and Steven Bosscher --- 1,5 ---- /* Intrinsic translation ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Paul Brook and Steven Bosscher *************** along with GCC; see the file COPYING3. *** 30,36 **** #include "ggc.h" #include "toplev.h" #include "real.h" ! #include "tree-gimple.h" #include "flags.h" #include "gfortran.h" #include "arith.h" --- 30,36 ---- #include "ggc.h" #include "toplev.h" #include "real.h" ! #include "gimple.h" #include "flags.h" #include "gfortran.h" #include "arith.h" *************** gfc_intrinsic_map_t; *** 104,116 **** true, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \ NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE}, ! #define LIBM_FUNCTION(ID, NAME, HAVE_COMPLEX) \ ! { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \ ! END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \ ! true, HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, \ ! NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE } ! ! #define LIBF_FUNCTION(ID, NAME, HAVE_COMPLEX) \ { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \ END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \ false, HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, \ --- 104,110 ---- true, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \ NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE}, ! #define LIB_FUNCTION(ID, NAME, HAVE_COMPLEX) \ { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \ END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \ false, HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, \ *************** static GTY(()) gfc_intrinsic_map_t gfc_i *** 121,146 **** /* Functions built into gcc itself. */ #include "mathbuiltins.def" - /* Functions in libm. */ - /* ??? This does exist as BUILT_IN_SCALBN, but doesn't quite fit the - pattern for other mathbuiltins.def entries. At present we have no - optimizations for this in the common sources. */ - LIBM_FUNCTION (SCALE, "scalbn", false), - /* Functions in libgfortran. */ ! LIBF_FUNCTION (FRACTION, "fraction", false), ! LIBF_FUNCTION (NEAREST, "nearest", false), ! LIBF_FUNCTION (RRSPACING, "rrspacing", false), ! LIBF_FUNCTION (SET_EXPONENT, "set_exponent", false), ! LIBF_FUNCTION (SPACING, "spacing", false), /* End the list. */ ! LIBF_FUNCTION (NONE, NULL, false) }; #undef DEFINE_MATH_BUILTIN #undef DEFINE_MATH_BUILTIN_C - #undef LIBM_FUNCTION - #undef LIBF_FUNCTION /* Structure for storing components of a floating number to be used by elemental functions to manipulate reals. */ --- 115,130 ---- /* Functions built into gcc itself. */ #include "mathbuiltins.def" /* Functions in libgfortran. */ ! LIB_FUNCTION (ERFC_SCALED, "erfc_scaled", false), /* End the list. */ ! LIB_FUNCTION (NONE, NULL, false) ! }; + #undef LIB_FUNCTION #undef DEFINE_MATH_BUILTIN #undef DEFINE_MATH_BUILTIN_C /* Structure for storing components of a floating number to be used by elemental functions to manipulate reals. */ *************** gfc_conv_intrinsic_conversion (gfc_se * *** 257,263 **** int nargs; nargs = gfc_intrinsic_argument_list_length (expr); ! args = alloca (sizeof (tree) * nargs); /* Evaluate all the arguments passed. Whilst we're only interested in the first one here, there are other parts of the front-end that assume this --- 241,247 ---- int nargs; nargs = gfc_intrinsic_argument_list_length (expr); ! args = (tree *) alloca (sizeof (tree) * nargs); /* Evaluate all the arguments passed. Whilst we're only interested in the first one here, there are other parts of the front-end that assume this *************** gfc_conv_intrinsic_conversion (gfc_se * *** 266,271 **** --- 250,290 ---- gcc_assert (expr->value.function.actual->expr); gfc_conv_intrinsic_function_args (se, expr, args, nargs); + /* Conversion between character kinds involves a call to a library + function. */ + if (expr->ts.type == BT_CHARACTER) + { + tree fndecl, var, addr, tmp; + + if (expr->ts.kind == 1 + && expr->value.function.actual->expr->ts.kind == 4) + fndecl = gfor_fndecl_convert_char4_to_char1; + else if (expr->ts.kind == 4 + && expr->value.function.actual->expr->ts.kind == 1) + fndecl = gfor_fndecl_convert_char1_to_char4; + else + gcc_unreachable (); + + /* Create the variable storing the converted value. */ + type = gfc_get_pchar_type (expr->ts.kind); + var = gfc_create_var (type, "str"); + addr = gfc_build_addr_expr (build_pointer_type (type), var); + + /* Call the library function that will perform the conversion. */ + gcc_assert (nargs >= 2); + tmp = build_call_expr (fndecl, 3, addr, args[0], args[1]); + gfc_add_expr_to_block (&se->pre, tmp); + + /* Free the temporary afterwards. */ + tmp = gfc_call_free (var); + gfc_add_expr_to_block (&se->post, tmp); + + se->expr = var; + se->string_length = args[0]; + + return; + } + /* Conversion from complex to non-complex involves taking the real component of the value. */ if (TREE_CODE (TREE_TYPE (args[0])) == COMPLEX_TYPE *************** gfc_conv_intrinsic_conversion (gfc_se * *** 274,280 **** tree artype; artype = TREE_TYPE (TREE_TYPE (args[0])); ! args[0] = build1 (REALPART_EXPR, artype, args[0]); } se->expr = convert (type, args[0]); --- 293,299 ---- tree artype; artype = TREE_TYPE (TREE_TYPE (args[0])); ! args[0] = fold_build1 (REALPART_EXPR, artype, args[0]); } se->expr = convert (type, args[0]); *************** build_fixbound_expr (stmtblock_t * pbloc *** 300,310 **** intval = gfc_evaluate_now (intval, pblock); tmp = convert (argtype, intval); ! cond = build2 (up ? GE_EXPR : LE_EXPR, boolean_type_node, tmp, arg); ! tmp = build2 (up ? PLUS_EXPR : MINUS_EXPR, type, intval, ! build_int_cst (type, 1)); ! tmp = build3 (COND_EXPR, type, cond, intval, tmp); return tmp; } --- 319,329 ---- intval = gfc_evaluate_now (intval, pblock); tmp = convert (argtype, intval); ! cond = fold_build2 (up ? GE_EXPR : LE_EXPR, boolean_type_node, tmp, arg); ! tmp = fold_build2 (up ? PLUS_EXPR : MINUS_EXPR, type, intval, ! build_int_cst (type, 1)); ! tmp = fold_build3 (COND_EXPR, type, cond, intval, tmp); return tmp; } *************** build_fix_expr (stmtblock_t * pblock, tr *** 370,376 **** break; case RND_TRUNC: ! return build1 (FIX_TRUNC_EXPR, type, arg); break; default: --- 389,395 ---- break; case RND_TRUNC: ! return fold_build1 (FIX_TRUNC_EXPR, type, arg); break; default: *************** gfc_conv_intrinsic_aint (gfc_se * se, gf *** 470,486 **** n = gfc_validate_kind (BT_INTEGER, kind, false); mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE); tmp = gfc_conv_mpfr_to_tree (huge, kind); ! cond = build2 (LT_EXPR, boolean_type_node, arg[0], tmp); mpfr_neg (huge, huge, GFC_RND_MODE); tmp = gfc_conv_mpfr_to_tree (huge, kind); ! tmp = build2 (GT_EXPR, boolean_type_node, arg[0], tmp); ! cond = build2 (TRUTH_AND_EXPR, boolean_type_node, cond, tmp); itype = gfc_get_int_type (kind); tmp = build_fix_expr (&se->pre, arg[0], itype, op); tmp = convert (type, tmp); ! se->expr = build3 (COND_EXPR, type, cond, tmp, arg[0]); mpfr_clear (huge); } --- 489,505 ---- n = gfc_validate_kind (BT_INTEGER, kind, false); mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE); tmp = gfc_conv_mpfr_to_tree (huge, kind); ! cond = fold_build2 (LT_EXPR, boolean_type_node, arg[0], tmp); mpfr_neg (huge, huge, GFC_RND_MODE); tmp = gfc_conv_mpfr_to_tree (huge, kind); ! tmp = fold_build2 (GT_EXPR, boolean_type_node, arg[0], tmp); ! cond = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond, tmp); itype = gfc_get_int_type (kind); tmp = build_fix_expr (&se->pre, arg[0], itype, op); tmp = convert (type, tmp); ! se->expr = fold_build3 (COND_EXPR, type, cond, tmp, arg[0]); mpfr_clear (huge); } *************** gfc_conv_intrinsic_int (gfc_se * se, gfc *** 495,501 **** int nargs; nargs = gfc_intrinsic_argument_list_length (expr); ! args = alloca (sizeof (tree) * nargs); /* Evaluate the argument, we process all arguments even though we only use the first one for code generation purposes. */ --- 514,520 ---- int nargs; nargs = gfc_intrinsic_argument_list_length (expr); ! args = (tree *) alloca (sizeof (tree) * nargs); /* Evaluate the argument, we process all arguments even though we only use the first one for code generation purposes. */ *************** gfc_conv_intrinsic_int (gfc_se * se, gfc *** 518,524 **** tree artype; artype = TREE_TYPE (TREE_TYPE (args[0])); ! args[0] = build1 (REALPART_EXPR, artype, args[0]); } se->expr = build_fix_expr (&se->pre, args[0], type, op); --- 537,543 ---- tree artype; artype = TREE_TYPE (TREE_TYPE (args[0])); ! args[0] = fold_build1 (REALPART_EXPR, artype, args[0]); } se->expr = build_fix_expr (&se->pre, args[0], type, op); *************** gfc_conv_intrinsic_imagpart (gfc_se * se *** 534,540 **** tree arg; gfc_conv_intrinsic_function_args (se, expr, &arg, 1); ! se->expr = build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (arg)), arg); } --- 553,559 ---- tree arg; gfc_conv_intrinsic_function_args (se, expr, &arg, 1); ! se->expr = fold_build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (arg)), arg); } *************** gfc_conv_intrinsic_conjg (gfc_se * se, g *** 546,552 **** tree arg; gfc_conv_intrinsic_function_args (se, expr, &arg, 1); ! se->expr = build1 (CONJ_EXPR, TREE_TYPE (arg), arg); } --- 565,571 ---- tree arg; gfc_conv_intrinsic_function_args (se, expr, &arg, 1); ! se->expr = fold_build1 (CONJ_EXPR, TREE_TYPE (arg), arg); } *************** gfc_conv_intrinsic_lib_function (gfc_se *** 717,723 **** /* Get the decl and generate the call. */ num_args = gfc_intrinsic_argument_list_length (expr); ! args = alloca (sizeof (tree) * num_args); gfc_conv_intrinsic_function_args (se, expr, args, num_args); fndecl = gfc_get_intrinsic_lib_fndecl (m, expr); --- 736,742 ---- /* Get the decl and generate the call. */ num_args = gfc_intrinsic_argument_list_length (expr); ! args = (tree *) alloca (sizeof (tree) * num_args); gfc_conv_intrinsic_function_args (se, expr, args, num_args); fndecl = gfc_get_intrinsic_lib_fndecl (m, expr); *************** gfc_conv_intrinsic_lib_function (gfc_se *** 727,764 **** se->expr = build_call_array (rettype, fndecl, num_args, args); } ! /* Generate code for EXPONENT(X) intrinsic function. */ static void gfc_conv_intrinsic_exponent (gfc_se *se, gfc_expr *expr) { ! tree arg, fndecl, type; ! gfc_expr *a1; ! ! gfc_conv_intrinsic_function_args (se, expr, &arg, 1); ! a1 = expr->value.function.actual->expr; ! switch (a1->ts.kind) { case 4: ! fndecl = gfor_fndecl_math_exponent4; break; case 8: ! fndecl = gfor_fndecl_math_exponent8; break; case 10: - fndecl = gfor_fndecl_math_exponent10; - break; case 16: ! fndecl = gfor_fndecl_math_exponent16; break; default: gcc_unreachable (); } ! /* Convert it to the required type. */ type = gfc_typenode_for_spec (&expr->ts); ! se->expr = fold_convert (type, build_call_expr (fndecl, 1, arg)); } /* Evaluate a single upper or lower bound. */ --- 746,817 ---- se->expr = build_call_array (rettype, fndecl, num_args, args); } ! ! /* If bounds-checking is enabled, create code to verify at runtime that the ! string lengths for both expressions are the same (needed for e.g. MERGE). ! If bounds-checking is not enabled, does nothing. */ ! ! void ! gfc_trans_same_strlen_check (const char* intr_name, locus* where, ! tree a, tree b, stmtblock_t* target) ! { ! tree cond; ! tree name; ! ! /* If bounds-checking is disabled, do nothing. */ ! if (!flag_bounds_check) ! return; ! ! /* Compare the two string lengths. */ ! cond = fold_build2 (NE_EXPR, boolean_type_node, a, b); ! ! /* Output the runtime-check. */ ! name = gfc_build_cstring_const (intr_name); ! name = gfc_build_addr_expr (pchar_type_node, name); ! gfc_trans_runtime_check (true, false, cond, target, where, ! "Unequal character lengths (%ld/%ld) in %s", ! fold_convert (long_integer_type_node, a), ! fold_convert (long_integer_type_node, b), name); ! } ! ! ! /* The EXPONENT(s) intrinsic function is translated into ! int ret; ! frexp (s, &ret); ! return ret; ! */ static void gfc_conv_intrinsic_exponent (gfc_se *se, gfc_expr *expr) { ! tree arg, type, res, tmp; ! int frexp; ! switch (expr->value.function.actual->expr->ts.kind) { case 4: ! frexp = BUILT_IN_FREXPF; break; case 8: ! frexp = BUILT_IN_FREXP; break; case 10: case 16: ! frexp = BUILT_IN_FREXPL; break; default: gcc_unreachable (); } ! gfc_conv_intrinsic_function_args (se, expr, &arg, 1); ! ! res = gfc_create_var (integer_type_node, NULL); ! tmp = build_call_expr (built_in_decls[frexp], 2, arg, ! build_fold_addr_expr (res)); ! gfc_add_expr_to_block (&se->pre, tmp); ! type = gfc_typenode_for_spec (&expr->ts); ! se->expr = fold_convert (type, res); } /* Evaluate a single upper or lower bound. */ *************** gfc_conv_intrinsic_bound (gfc_se * se, g *** 840,846 **** tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))]; tmp = fold_build2 (GE_EXPR, boolean_type_node, bound, tmp); cond = fold_build2 (TRUTH_ORIF_EXPR, boolean_type_node, cond, tmp); ! gfc_trans_runtime_check (cond, &se->pre, &expr->where, gfc_msg_fault); } } --- 893,900 ---- tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))]; tmp = fold_build2 (GE_EXPR, boolean_type_node, bound, tmp); cond = fold_build2 (TRUTH_ORIF_EXPR, boolean_type_node, cond, tmp); ! gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where, ! gfc_msg_fault); } } *************** gfc_conv_intrinsic_bound (gfc_se * se, g *** 876,881 **** --- 930,936 ---- case AR_FULL: break; } + break; } } } *************** gfc_conv_intrinsic_bound (gfc_se * se, g *** 917,928 **** cond4 = fold_build2 (LT_EXPR, boolean_type_node, stride, gfc_index_zero_node); - cond4 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond4, cond2); if (upper) { cond = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond3, cond4); se->expr = fold_build3 (COND_EXPR, gfc_array_index_type, cond, ubound, gfc_index_zero_node); } --- 972,988 ---- cond4 = fold_build2 (LT_EXPR, boolean_type_node, stride, gfc_index_zero_node); if (upper) { + tree cond5; cond = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond3, cond4); + cond5 = fold_build2 (EQ_EXPR, boolean_type_node, gfc_index_one_node, lbound); + cond5 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond4, cond5); + + cond = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond, cond5); + se->expr = fold_build3 (COND_EXPR, gfc_array_index_type, cond, ubound, gfc_index_zero_node); } *************** gfc_conv_intrinsic_bound (gfc_se * se, g *** 949,954 **** --- 1009,1016 ---- size = fold_build2 (MINUS_EXPR, gfc_array_index_type, ubound, lbound); se->expr = fold_build2 (PLUS_EXPR, gfc_array_index_type, size, gfc_index_one_node); + se->expr = fold_build2 (MAX_EXPR, gfc_array_index_type, se->expr, + gfc_index_zero_node); } else se->expr = gfc_index_one_node; *************** gfc_conv_intrinsic_abs (gfc_se * se, gfc *** 971,977 **** { case BT_INTEGER: case BT_REAL: ! se->expr = build1 (ABS_EXPR, TREE_TYPE (arg), arg); break; case BT_COMPLEX: --- 1033,1039 ---- { case BT_INTEGER: case BT_REAL: ! se->expr = fold_build1 (ABS_EXPR, TREE_TYPE (arg), arg); break; case BT_COMPLEX: *************** gfc_conv_intrinsic_cmplx (gfc_se * se, g *** 1011,1017 **** unsigned int num_args; num_args = gfc_intrinsic_argument_list_length (expr); ! args = alloca (sizeof (tree) * num_args); type = gfc_typenode_for_spec (&expr->ts); gfc_conv_intrinsic_function_args (se, expr, args, num_args); --- 1073,1079 ---- unsigned int num_args; num_args = gfc_intrinsic_argument_list_length (expr); ! args = (tree *) alloca (sizeof (tree) * num_args); type = gfc_typenode_for_spec (&expr->ts); gfc_conv_intrinsic_function_args (se, expr, args, num_args); *************** gfc_conv_intrinsic_cmplx (gfc_se * se, g *** 1020,1026 **** imag = convert (TREE_TYPE (type), args[1]); else if (TREE_CODE (TREE_TYPE (args[0])) == COMPLEX_TYPE) { ! imag = build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (args[0])), args[0]); imag = convert (TREE_TYPE (type), imag); } else --- 1082,1089 ---- imag = convert (TREE_TYPE (type), args[1]); else if (TREE_CODE (TREE_TYPE (args[0])) == COMPLEX_TYPE) { ! imag = fold_build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (args[0])), ! args[0]); imag = convert (TREE_TYPE (type), imag); } else *************** gfc_conv_intrinsic_mod (gfc_se * se, gfc *** 1054,1062 **** type = TREE_TYPE (args[0]); if (modulo) ! se->expr = build2 (FLOOR_MOD_EXPR, type, args[0], args[1]); else ! se->expr = build2 (TRUNC_MOD_EXPR, type, args[0], args[1]); break; case BT_REAL: --- 1117,1125 ---- type = TREE_TYPE (args[0]); if (modulo) ! se->expr = fold_build2 (FLOOR_MOD_EXPR, type, args[0], args[1]); else ! se->expr = fold_build2 (TRUNC_MOD_EXPR, type, args[0], args[1]); break; case BT_REAL: *************** gfc_conv_intrinsic_mod (gfc_se * se, gfc *** 1107,1126 **** { tree zero = gfc_build_const (type, integer_zero_node); tmp = gfc_evaluate_now (se->expr, &se->pre); ! test = build2 (LT_EXPR, boolean_type_node, args[0], zero); ! test2 = build2 (LT_EXPR, boolean_type_node, args[1], zero); ! test2 = build2 (TRUTH_XOR_EXPR, boolean_type_node, test, test2); ! test = build2 (NE_EXPR, boolean_type_node, tmp, zero); ! test = build2 (TRUTH_AND_EXPR, boolean_type_node, test, test2); test = gfc_evaluate_now (test, &se->pre); ! se->expr = build3 (COND_EXPR, type, test, ! build2 (PLUS_EXPR, type, tmp, args[1]), tmp); return; } /* If we do not have a built_in fmod, the calculation is going to have to be done longhand. */ ! tmp = build2 (RDIV_EXPR, type, args[0], args[1]); /* Test if the value is too large to handle sensibly. */ gfc_set_model_kind (expr->ts.kind); --- 1170,1190 ---- { tree zero = gfc_build_const (type, integer_zero_node); tmp = gfc_evaluate_now (se->expr, &se->pre); ! test = fold_build2 (LT_EXPR, boolean_type_node, args[0], zero); ! test2 = fold_build2 (LT_EXPR, boolean_type_node, args[1], zero); ! test2 = fold_build2 (TRUTH_XOR_EXPR, boolean_type_node, test, test2); ! test = fold_build2 (NE_EXPR, boolean_type_node, tmp, zero); ! test = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, test, test2); test = gfc_evaluate_now (test, &se->pre); ! se->expr = fold_build3 (COND_EXPR, type, test, ! fold_build2 (PLUS_EXPR, type, tmp, args[1]), ! tmp); return; } /* If we do not have a built_in fmod, the calculation is going to have to be done longhand. */ ! tmp = fold_build2 (RDIV_EXPR, type, args[0], args[1]); /* Test if the value is too large to handle sensibly. */ gfc_set_model_kind (expr->ts.kind); *************** gfc_conv_intrinsic_mod (gfc_se * se, gfc *** 1134,1145 **** } mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE); test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind); ! test2 = build2 (LT_EXPR, boolean_type_node, tmp, test); mpfr_neg (huge, huge, GFC_RND_MODE); test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind); ! test = build2 (GT_EXPR, boolean_type_node, tmp, test); ! test2 = build2 (TRUTH_AND_EXPR, boolean_type_node, test, test2); itype = gfc_get_int_type (ikind); if (modulo) --- 1198,1209 ---- } mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE); test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind); ! test2 = fold_build2 (LT_EXPR, boolean_type_node, tmp, test); mpfr_neg (huge, huge, GFC_RND_MODE); test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind); ! test = fold_build2 (GT_EXPR, boolean_type_node, tmp, test); ! test2 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, test, test2); itype = gfc_get_int_type (ikind); if (modulo) *************** gfc_conv_intrinsic_mod (gfc_se * se, gfc *** 1147,1155 **** else tmp = build_fix_expr (&se->pre, tmp, itype, RND_TRUNC); tmp = convert (type, tmp); ! tmp = build3 (COND_EXPR, type, test2, tmp, args[0]); ! tmp = build2 (MULT_EXPR, type, tmp, args[1]); ! se->expr = build2 (MINUS_EXPR, type, args[0], tmp); mpfr_clear (huge); break; --- 1211,1219 ---- else tmp = build_fix_expr (&se->pre, tmp, itype, RND_TRUNC); tmp = convert (type, tmp); ! tmp = fold_build3 (COND_EXPR, type, test2, tmp, args[0]); ! tmp = fold_build2 (MULT_EXPR, type, tmp, args[1]); ! se->expr = fold_build2 (MINUS_EXPR, type, args[0], tmp); mpfr_clear (huge); break; *************** gfc_conv_intrinsic_dim (gfc_se * se, gfc *** 1172,1183 **** gfc_conv_intrinsic_function_args (se, expr, args, 2); type = TREE_TYPE (args[0]); ! val = build2 (MINUS_EXPR, type, args[0], args[1]); val = gfc_evaluate_now (val, &se->pre); zero = gfc_build_const (type, integer_zero_node); ! tmp = build2 (LE_EXPR, boolean_type_node, val, zero); ! se->expr = build3 (COND_EXPR, type, tmp, zero, val); } --- 1236,1247 ---- gfc_conv_intrinsic_function_args (se, expr, args, 2); type = TREE_TYPE (args[0]); ! val = fold_build2 (MINUS_EXPR, type, args[0], args[1]); val = gfc_evaluate_now (val, &se->pre); zero = gfc_build_const (type, integer_zero_node); ! tmp = fold_build2 (LE_EXPR, boolean_type_node, val, zero); ! se->expr = fold_build3 (COND_EXPR, type, tmp, zero, val); } *************** gfc_conv_intrinsic_dprod (gfc_se * se, g *** 1266,1272 **** type = gfc_typenode_for_spec (&expr->ts); args[0] = convert (type, args[0]); args[1] = convert (type, args[1]); ! se->expr = build2 (MULT_EXPR, type, args[0], args[1]); } --- 1330,1336 ---- type = gfc_typenode_for_spec (&expr->ts); args[0] = convert (type, args[0]); args[1] = convert (type, args[1]); ! se->expr = fold_build2 (MULT_EXPR, type, args[0], args[1]); } *************** gfc_conv_intrinsic_char (gfc_se * se, gf *** 1280,1296 **** tree type; unsigned int num_args; - /* We must allow for the KIND argument, even though.... */ num_args = gfc_intrinsic_argument_list_length (expr); gfc_conv_intrinsic_function_args (se, expr, arg, num_args); ! /* .... we currently don't support character types != 1. */ ! gcc_assert (expr->ts.kind == 1); ! type = gfc_character1_type_node; var = gfc_create_var (type, "char"); ! arg[0] = convert (type, arg[0]); ! gfc_add_modify_expr (&se->pre, var, arg[0]); se->expr = gfc_build_addr_expr (build_pointer_type (type), var); se->string_length = integer_one_node; } --- 1344,1357 ---- tree type; unsigned int num_args; num_args = gfc_intrinsic_argument_list_length (expr); gfc_conv_intrinsic_function_args (se, expr, arg, num_args); ! type = gfc_get_char_type (expr->ts.kind); var = gfc_create_var (type, "char"); ! arg[0] = fold_build1 (NOP_EXPR, type, arg[0]); ! gfc_add_modify (&se->pre, var, arg[0]); se->expr = gfc_build_addr_expr (build_pointer_type (type), var); se->string_length = integer_one_node; } *************** gfc_conv_intrinsic_ctime (gfc_se * se, g *** 1302,1320 **** tree var; tree len; tree tmp; - tree type; tree cond; - tree gfc_int8_type_node = gfc_get_int_type (8); tree fndecl; tree *args; unsigned int num_args; num_args = gfc_intrinsic_argument_list_length (expr) + 2; ! args = alloca (sizeof (tree) * num_args); ! type = build_pointer_type (gfc_character1_type_node); ! var = gfc_create_var (type, "pstr"); ! len = gfc_create_var (gfc_int8_type_node, "len"); gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2); args[0] = build_fold_addr_expr (var); --- 1363,1378 ---- tree var; tree len; tree tmp; tree cond; tree fndecl; tree *args; unsigned int num_args; num_args = gfc_intrinsic_argument_list_length (expr) + 2; ! args = (tree *) alloca (sizeof (tree) * num_args); ! var = gfc_create_var (pchar_type_node, "pstr"); ! len = gfc_create_var (gfc_get_int_type (8), "len"); gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2); args[0] = build_fold_addr_expr (var); *************** gfc_conv_intrinsic_ctime (gfc_se * se, g *** 1326,1333 **** gfc_add_expr_to_block (&se->pre, tmp); /* Free the temporary afterwards, if necessary. */ ! cond = build2 (GT_EXPR, boolean_type_node, len, ! build_int_cst (TREE_TYPE (len), 0)); tmp = gfc_call_free (var); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); gfc_add_expr_to_block (&se->post, tmp); --- 1384,1391 ---- gfc_add_expr_to_block (&se->pre, tmp); /* Free the temporary afterwards, if necessary. */ ! cond = fold_build2 (GT_EXPR, boolean_type_node, ! len, build_int_cst (TREE_TYPE (len), 0)); tmp = gfc_call_free (var); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); gfc_add_expr_to_block (&se->post, tmp); *************** gfc_conv_intrinsic_fdate (gfc_se * se, g *** 1343,1361 **** tree var; tree len; tree tmp; - tree type; tree cond; - tree gfc_int4_type_node = gfc_get_int_type (4); tree fndecl; tree *args; unsigned int num_args; num_args = gfc_intrinsic_argument_list_length (expr) + 2; ! args = alloca (sizeof (tree) * num_args); ! type = build_pointer_type (gfc_character1_type_node); ! var = gfc_create_var (type, "pstr"); ! len = gfc_create_var (gfc_int4_type_node, "len"); gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2); args[0] = build_fold_addr_expr (var); --- 1401,1416 ---- tree var; tree len; tree tmp; tree cond; tree fndecl; tree *args; unsigned int num_args; num_args = gfc_intrinsic_argument_list_length (expr) + 2; ! args = (tree *) alloca (sizeof (tree) * num_args); ! var = gfc_create_var (pchar_type_node, "pstr"); ! len = gfc_create_var (gfc_get_int_type (4), "len"); gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2); args[0] = build_fold_addr_expr (var); *************** gfc_conv_intrinsic_fdate (gfc_se * se, g *** 1367,1374 **** gfc_add_expr_to_block (&se->pre, tmp); /* Free the temporary afterwards, if necessary. */ ! cond = build2 (GT_EXPR, boolean_type_node, len, ! build_int_cst (TREE_TYPE (len), 0)); tmp = gfc_call_free (var); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); gfc_add_expr_to_block (&se->post, tmp); --- 1422,1429 ---- gfc_add_expr_to_block (&se->pre, tmp); /* Free the temporary afterwards, if necessary. */ ! cond = fold_build2 (GT_EXPR, boolean_type_node, ! len, build_int_cst (TREE_TYPE (len), 0)); tmp = gfc_call_free (var); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); gfc_add_expr_to_block (&se->post, tmp); *************** gfc_conv_intrinsic_ttynam (gfc_se * se, *** 1386,1404 **** tree var; tree len; tree tmp; - tree type; tree cond; tree fndecl; - tree gfc_int4_type_node = gfc_get_int_type (4); tree *args; unsigned int num_args; num_args = gfc_intrinsic_argument_list_length (expr) + 2; ! args = alloca (sizeof (tree) * num_args); ! type = build_pointer_type (gfc_character1_type_node); ! var = gfc_create_var (type, "pstr"); ! len = gfc_create_var (gfc_int4_type_node, "len"); gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2); args[0] = build_fold_addr_expr (var); --- 1441,1456 ---- tree var; tree len; tree tmp; tree cond; tree fndecl; tree *args; unsigned int num_args; num_args = gfc_intrinsic_argument_list_length (expr) + 2; ! args = (tree *) alloca (sizeof (tree) * num_args); ! var = gfc_create_var (pchar_type_node, "pstr"); ! len = gfc_create_var (gfc_get_int_type (4), "len"); gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2); args[0] = build_fold_addr_expr (var); *************** gfc_conv_intrinsic_ttynam (gfc_se * se, *** 1410,1417 **** gfc_add_expr_to_block (&se->pre, tmp); /* Free the temporary afterwards, if necessary. */ ! cond = build2 (GT_EXPR, boolean_type_node, len, ! build_int_cst (TREE_TYPE (len), 0)); tmp = gfc_call_free (var); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); gfc_add_expr_to_block (&se->post, tmp); --- 1462,1469 ---- gfc_add_expr_to_block (&se->pre, tmp); /* Free the temporary afterwards, if necessary. */ ! cond = fold_build2 (GT_EXPR, boolean_type_node, ! len, build_int_cst (TREE_TYPE (len), 0)); tmp = gfc_call_free (var); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); gfc_add_expr_to_block (&se->post, tmp); *************** gfc_conv_intrinsic_minmax (gfc_se * se, *** 1449,1455 **** unsigned int i, nargs; nargs = gfc_intrinsic_argument_list_length (expr); ! args = alloca (sizeof (tree) * nargs); gfc_conv_intrinsic_function_args (se, expr, args, nargs); type = gfc_typenode_for_spec (&expr->ts); --- 1501,1507 ---- unsigned int i, nargs; nargs = gfc_intrinsic_argument_list_length (expr); ! args = (tree *) alloca (sizeof (tree) * nargs); gfc_conv_intrinsic_function_args (se, expr, args, nargs); type = gfc_typenode_for_spec (&expr->ts); *************** gfc_conv_intrinsic_minmax (gfc_se * se, *** 1462,1468 **** args[0] = gfc_evaluate_now (args[0], &se->pre); mvar = gfc_create_var (type, "M"); ! gfc_add_modify_expr (&se->pre, mvar, args[0]); for (i = 1, argexpr = argexpr->next; i < nargs; i++) { tree cond, isnan; --- 1514,1520 ---- args[0] = gfc_evaluate_now (args[0], &se->pre); mvar = gfc_create_var (type, "M"); ! gfc_add_modify (&se->pre, mvar, args[0]); for (i = 1, argexpr = argexpr->next; i < nargs; i++) { tree cond, isnan; *************** gfc_conv_intrinsic_minmax (gfc_se * se, *** 1473,1480 **** if (argexpr->expr->expr_type == EXPR_VARIABLE && argexpr->expr->symtree->n.sym->attr.optional && TREE_CODE (val) == INDIRECT_REF) ! cond = build2 (NE_EXPR, boolean_type_node, TREE_OPERAND (val, 0), ! build_int_cst (TREE_TYPE (TREE_OPERAND (val, 0)), 0)); else { cond = NULL_TREE; --- 1525,1533 ---- if (argexpr->expr->expr_type == EXPR_VARIABLE && argexpr->expr->symtree->n.sym->attr.optional && TREE_CODE (val) == INDIRECT_REF) ! cond = fold_build2 ! (NE_EXPR, boolean_type_node, TREE_OPERAND (val, 0), ! build_int_cst (TREE_TYPE (TREE_OPERAND (val, 0)), 0)); else { cond = NULL_TREE; *************** gfc_conv_intrinsic_minmax (gfc_se * se, *** 1486,1492 **** thencase = build2_v (MODIFY_EXPR, mvar, convert (type, val)); ! tmp = build2 (op, boolean_type_node, convert (type, val), mvar); /* FIXME: When the IEEE_ARITHMETIC module is implemented, the call to __builtin_isnan might be made dependent on that module being loaded, --- 1539,1545 ---- thencase = build2_v (MODIFY_EXPR, mvar, convert (type, val)); ! tmp = fold_build2 (op, boolean_type_node, convert (type, val), mvar); /* FIXME: When the IEEE_ARITHMETIC module is implemented, the call to __builtin_isnan might be made dependent on that module being loaded, *************** static void *** 1515,1544 **** gfc_conv_intrinsic_minmax_char (gfc_se * se, gfc_expr * expr, int op) { tree *args; ! tree var, len, fndecl, tmp, cond; unsigned int nargs; nargs = gfc_intrinsic_argument_list_length (expr); ! args = alloca (sizeof (tree) * (nargs + 4)); gfc_conv_intrinsic_function_args (se, expr, &args[4], nargs); /* Create the result variables. */ len = gfc_create_var (gfc_charlen_type_node, "len"); args[0] = build_fold_addr_expr (len); ! var = gfc_create_var (build_pointer_type (gfc_character1_type_node), "pstr"); args[1] = gfc_build_addr_expr (ppvoid_type_node, var); args[2] = build_int_cst (NULL_TREE, op); args[3] = build_int_cst (NULL_TREE, nargs / 2); /* Make the function call. */ ! fndecl = build_addr (gfor_fndecl_string_minmax, current_function_decl); ! tmp = build_call_array (TREE_TYPE (TREE_TYPE (gfor_fndecl_string_minmax)), ! fndecl, nargs + 4, args); gfc_add_expr_to_block (&se->pre, tmp); /* Free the temporary afterwards, if necessary. */ ! cond = build2 (GT_EXPR, boolean_type_node, len, ! build_int_cst (TREE_TYPE (len), 0)); tmp = gfc_call_free (var); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); gfc_add_expr_to_block (&se->post, tmp); --- 1568,1604 ---- gfc_conv_intrinsic_minmax_char (gfc_se * se, gfc_expr * expr, int op) { tree *args; ! tree var, len, fndecl, tmp, cond, function; unsigned int nargs; nargs = gfc_intrinsic_argument_list_length (expr); ! args = (tree *) alloca (sizeof (tree) * (nargs + 4)); gfc_conv_intrinsic_function_args (se, expr, &args[4], nargs); /* Create the result variables. */ len = gfc_create_var (gfc_charlen_type_node, "len"); args[0] = build_fold_addr_expr (len); ! var = gfc_create_var (gfc_get_pchar_type (expr->ts.kind), "pstr"); args[1] = gfc_build_addr_expr (ppvoid_type_node, var); args[2] = build_int_cst (NULL_TREE, op); args[3] = build_int_cst (NULL_TREE, nargs / 2); + if (expr->ts.kind == 1) + function = gfor_fndecl_string_minmax; + else if (expr->ts.kind == 4) + function = gfor_fndecl_string_minmax_char4; + else + gcc_unreachable (); + /* Make the function call. */ ! fndecl = build_addr (function, current_function_decl); ! tmp = build_call_array (TREE_TYPE (TREE_TYPE (function)), fndecl, ! nargs + 4, args); gfc_add_expr_to_block (&se->pre, tmp); /* Free the temporary afterwards, if necessary. */ ! cond = fold_build2 (GT_EXPR, boolean_type_node, ! len, build_int_cst (TREE_TYPE (len), 0)); tmp = gfc_call_free (var); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); gfc_add_expr_to_block (&se->post, tmp); *************** gfc_conv_intrinsic_anyall (gfc_se * se, *** 1693,1699 **** tmp = convert (type, boolean_true_node); else tmp = convert (type, boolean_false_node); ! gfc_add_modify_expr (&se->pre, resvar, tmp); /* Walk the arguments. */ arrayss = gfc_walk_expr (actual->expr); --- 1753,1759 ---- tmp = convert (type, boolean_true_node); else tmp = convert (type, boolean_false_node); ! gfc_add_modify (&se->pre, resvar, tmp); /* Walk the arguments. */ arrayss = gfc_walk_expr (actual->expr); *************** gfc_conv_intrinsic_anyall (gfc_se * se, *** 1707,1713 **** /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop); gfc_mark_ss_chain_used (arrayss, 1); /* Generate the loop body. */ --- 1767,1773 ---- /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop, &expr->where); gfc_mark_ss_chain_used (arrayss, 1); /* Generate the loop body. */ *************** gfc_conv_intrinsic_anyall (gfc_se * se, *** 1719,1725 **** tmp = convert (type, boolean_false_node); else tmp = convert (type, boolean_true_node); ! gfc_add_modify_expr (&block, resvar, tmp); /* And break out of the loop. */ tmp = build1_v (GOTO_EXPR, exit_label); --- 1779,1785 ---- tmp = convert (type, boolean_false_node); else tmp = convert (type, boolean_true_node); ! gfc_add_modify (&block, resvar, tmp); /* And break out of the loop. */ tmp = build1_v (GOTO_EXPR, exit_label); *************** gfc_conv_intrinsic_count (gfc_se * se, g *** 1777,1783 **** type = gfc_typenode_for_spec (&expr->ts); /* Initialize the result. */ resvar = gfc_create_var (type, "count"); ! gfc_add_modify_expr (&se->pre, resvar, build_int_cst (type, 0)); /* Walk the arguments. */ arrayss = gfc_walk_expr (actual->expr); --- 1837,1843 ---- type = gfc_typenode_for_spec (&expr->ts); /* Initialize the result. */ resvar = gfc_create_var (type, "count"); ! gfc_add_modify (&se->pre, resvar, build_int_cst (type, 0)); /* Walk the arguments. */ arrayss = gfc_walk_expr (actual->expr); *************** gfc_conv_intrinsic_count (gfc_se * se, g *** 1789,1802 **** /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop); gfc_mark_ss_chain_used (arrayss, 1); /* Generate the loop body. */ gfc_start_scalarized_body (&loop, &body); ! tmp = build2 (PLUS_EXPR, TREE_TYPE (resvar), resvar, ! build_int_cst (TREE_TYPE (resvar), 1)); tmp = build2_v (MODIFY_EXPR, resvar, tmp); gfc_init_se (&arrayse, NULL); --- 1849,1862 ---- /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop, &expr->where); gfc_mark_ss_chain_used (arrayss, 1); /* Generate the loop body. */ gfc_start_scalarized_body (&loop, &body); ! tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (resvar), ! resvar, build_int_cst (TREE_TYPE (resvar), 1)); tmp = build2_v (MODIFY_EXPR, resvar, tmp); gfc_init_se (&arrayse, NULL); *************** gfc_conv_intrinsic_arith (gfc_se * se, g *** 1850,1856 **** else tmp = gfc_build_const (type, integer_one_node); ! gfc_add_modify_expr (&se->pre, resvar, tmp); /* Walk the arguments. */ actual = expr->value.function.actual; --- 1910,1916 ---- else tmp = gfc_build_const (type, integer_one_node); ! gfc_add_modify (&se->pre, resvar, tmp); /* Walk the arguments. */ actual = expr->value.function.actual; *************** gfc_conv_intrinsic_arith (gfc_se * se, g *** 1877,1883 **** /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop); gfc_mark_ss_chain_used (arrayss, 1); if (maskss) --- 1937,1943 ---- /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop, &expr->where); gfc_mark_ss_chain_used (arrayss, 1); if (maskss) *************** gfc_conv_intrinsic_arith (gfc_se * se, g *** 1906,1913 **** gfc_conv_expr_val (&arrayse, arrayexpr); gfc_add_block_to_block (&block, &arrayse.pre); ! tmp = build2 (op, type, resvar, arrayse.expr); ! gfc_add_modify_expr (&block, resvar, tmp); gfc_add_block_to_block (&block, &arrayse.post); if (maskss) --- 1966,1973 ---- gfc_conv_expr_val (&arrayse, arrayexpr); gfc_add_block_to_block (&block, &arrayse.pre); ! tmp = fold_build2 (op, type, resvar, arrayse.expr); ! gfc_add_modify (&block, resvar, tmp); gfc_add_block_to_block (&block, &arrayse.post); if (maskss) *************** gfc_conv_intrinsic_dot_product (gfc_se * *** 1974,1980 **** else tmp = gfc_build_const (type, integer_zero_node); ! gfc_add_modify_expr (&se->pre, resvar, tmp); /* Walk argument #1. */ actual = expr->value.function.actual; --- 2034,2040 ---- else tmp = gfc_build_const (type, integer_zero_node); ! gfc_add_modify (&se->pre, resvar, tmp); /* Walk argument #1. */ actual = expr->value.function.actual; *************** gfc_conv_intrinsic_dot_product (gfc_se * *** 1995,2001 **** /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop); gfc_mark_ss_chain_used (arrayss1, 1); gfc_mark_ss_chain_used (arrayss2, 1); --- 2055,2061 ---- /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop, &expr->where); gfc_mark_ss_chain_used (arrayss1, 1); gfc_mark_ss_chain_used (arrayss2, 1); *************** gfc_conv_intrinsic_dot_product (gfc_se * *** 2010,2016 **** arrayse1.ss = arrayss1; gfc_conv_expr_val (&arrayse1, arrayexpr1); if (expr->ts.type == BT_COMPLEX) ! arrayse1.expr = build1 (CONJ_EXPR, type, arrayse1.expr); gfc_add_block_to_block (&block, &arrayse1.pre); /* Make the tree expression for array2. */ --- 2070,2076 ---- arrayse1.ss = arrayss1; gfc_conv_expr_val (&arrayse1, arrayexpr1); if (expr->ts.type == BT_COMPLEX) ! arrayse1.expr = fold_build1 (CONJ_EXPR, type, arrayse1.expr); gfc_add_block_to_block (&block, &arrayse1.pre); /* Make the tree expression for array2. */ *************** gfc_conv_intrinsic_dot_product (gfc_se * *** 2023,2037 **** /* Do the actual product and sum. */ if (expr->ts.type == BT_LOGICAL) { ! tmp = build2 (TRUTH_AND_EXPR, type, arrayse1.expr, arrayse2.expr); ! tmp = build2 (TRUTH_OR_EXPR, type, resvar, tmp); } else { ! tmp = build2 (MULT_EXPR, type, arrayse1.expr, arrayse2.expr); ! tmp = build2 (PLUS_EXPR, type, resvar, tmp); } ! gfc_add_modify_expr (&block, resvar, tmp); /* Finish up the loop block and the loop. */ tmp = gfc_finish_block (&block); --- 2083,2097 ---- /* Do the actual product and sum. */ if (expr->ts.type == BT_LOGICAL) { ! tmp = fold_build2 (TRUTH_AND_EXPR, type, arrayse1.expr, arrayse2.expr); ! tmp = fold_build2 (TRUTH_OR_EXPR, type, resvar, tmp); } else { ! tmp = fold_build2 (MULT_EXPR, type, arrayse1.expr, arrayse2.expr); ! tmp = fold_build2 (PLUS_EXPR, type, resvar, tmp); } ! gfc_add_modify (&block, resvar, tmp); /* Finish up the loop block and the loop. */ tmp = gfc_finish_block (&block); *************** gfc_conv_intrinsic_minmaxloc (gfc_se * s *** 2121,2131 **** possible value is HUGE in both cases. */ if (op == GT_EXPR) tmp = fold_build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp); ! gfc_add_modify_expr (&se->pre, limit, tmp); if (op == GT_EXPR && expr->ts.type == BT_INTEGER) ! tmp = build2 (MINUS_EXPR, TREE_TYPE (tmp), tmp, ! build_int_cst (type, 1)); /* Initialize the scalarizer. */ gfc_init_loopinfo (&loop); --- 2181,2191 ---- possible value is HUGE in both cases. */ if (op == GT_EXPR) tmp = fold_build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp); ! gfc_add_modify (&se->pre, limit, tmp); if (op == GT_EXPR && expr->ts.type == BT_INTEGER) ! tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (tmp), tmp, ! build_int_cst (type, 1)); /* Initialize the scalarizer. */ gfc_init_loopinfo (&loop); *************** gfc_conv_intrinsic_minmaxloc (gfc_se * s *** 2135,2148 **** /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop); gcc_assert (loop.dimen == 1); /* Initialize the position to zero, following Fortran 2003. We are free to do this because Fortran 95 allows the result of an entirely false mask to be processor dependent. */ ! gfc_add_modify_expr (&loop.pre, pos, gfc_index_zero_node); gfc_mark_ss_chain_used (arrayss, 1); if (maskss) --- 2195,2208 ---- /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop, &expr->where); gcc_assert (loop.dimen == 1); /* Initialize the position to zero, following Fortran 2003. We are free to do this because Fortran 95 allows the result of an entirely false mask to be processor dependent. */ ! gfc_add_modify (&loop.pre, pos, gfc_index_zero_node); gfc_mark_ss_chain_used (arrayss, 1); if (maskss) *************** gfc_conv_intrinsic_minmaxloc (gfc_se * s *** 2175,2181 **** gfc_start_block (&ifblock); /* Assign the value to the limit... */ ! gfc_add_modify_expr (&ifblock, limit, arrayse.expr); /* Remember where we are. An offset must be added to the loop counter to obtain the required position. */ --- 2235,2241 ---- gfc_start_block (&ifblock); /* Assign the value to the limit... */ ! gfc_add_modify (&ifblock, limit, arrayse.expr); /* Remember where we are. An offset must be added to the loop counter to obtain the required position. */ *************** gfc_conv_intrinsic_minmaxloc (gfc_se * s *** 2183,2205 **** tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, gfc_index_one_node, loop.from[0]); else ! tmp = build_int_cst (gfc_array_index_type, 1); ! gfc_add_modify_expr (&block, offset, tmp); ! tmp = build2 (PLUS_EXPR, TREE_TYPE (pos), ! loop.loopvar[0], offset); ! gfc_add_modify_expr (&ifblock, pos, tmp); ifbody = gfc_finish_block (&ifblock); /* If it is a more extreme value or pos is still zero and the value equal to the limit. */ ! tmp = build2 (TRUTH_AND_EXPR, boolean_type_node, ! build2 (EQ_EXPR, boolean_type_node, pos, gfc_index_zero_node), ! build2 (EQ_EXPR, boolean_type_node, arrayse.expr, limit)); ! tmp = build2 (TRUTH_OR_EXPR, boolean_type_node, ! build2 (op, boolean_type_node, arrayse.expr, limit), tmp); tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt ()); gfc_add_expr_to_block (&block, tmp); --- 2243,2268 ---- tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, gfc_index_one_node, loop.from[0]); else ! tmp = gfc_index_one_node; ! gfc_add_modify (&block, offset, tmp); ! tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (pos), ! loop.loopvar[0], offset); ! gfc_add_modify (&ifblock, pos, tmp); ifbody = gfc_finish_block (&ifblock); /* If it is a more extreme value or pos is still zero and the value equal to the limit. */ ! tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, ! fold_build2 (EQ_EXPR, boolean_type_node, ! pos, gfc_index_zero_node), ! fold_build2 (EQ_EXPR, boolean_type_node, ! arrayse.expr, limit)); ! tmp = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, ! fold_build2 (op, boolean_type_node, ! arrayse.expr, limit), tmp); tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt ()); gfc_add_expr_to_block (&block, tmp); *************** gfc_conv_intrinsic_minmaxloc (gfc_se * s *** 2230,2236 **** the pos variable the same way as above. */ gfc_init_block (&elseblock); ! gfc_add_modify_expr (&elseblock, pos, gfc_index_zero_node); elsetmp = gfc_finish_block (&elseblock); tmp = build3_v (COND_EXPR, maskse.expr, tmp, elsetmp); --- 2293,2299 ---- the pos variable the same way as above. */ gfc_init_block (&elseblock); ! gfc_add_modify (&elseblock, pos, gfc_index_zero_node); elsetmp = gfc_finish_block (&elseblock); tmp = build3_v (COND_EXPR, maskse.expr, tmp, elsetmp); *************** gfc_conv_intrinsic_minmaxval (gfc_se * s *** 2298,2307 **** tmp = fold_build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp); if (op == GT_EXPR && expr->ts.type == BT_INTEGER) ! tmp = build2 (MINUS_EXPR, TREE_TYPE (tmp), tmp, ! build_int_cst (type, 1)); ! gfc_add_modify_expr (&se->pre, limit, tmp); /* Walk the arguments. */ actual = expr->value.function.actual; --- 2361,2370 ---- tmp = fold_build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp); if (op == GT_EXPR && expr->ts.type == BT_INTEGER) ! tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (tmp), ! tmp, build_int_cst (type, 1)); ! gfc_add_modify (&se->pre, limit, tmp); /* Walk the arguments. */ actual = expr->value.function.actual; *************** gfc_conv_intrinsic_minmaxval (gfc_se * s *** 2328,2334 **** /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop); gfc_mark_ss_chain_used (arrayss, 1); if (maskss) --- 2391,2397 ---- /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop, &expr->where); gfc_mark_ss_chain_used (arrayss, 1); if (maskss) *************** gfc_conv_intrinsic_minmaxval (gfc_se * s *** 2361,2367 **** ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr); /* If it is a more extreme value. */ ! tmp = build2 (op, boolean_type_node, arrayse.expr, limit); tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt ()); gfc_add_expr_to_block (&block, tmp); gfc_add_block_to_block (&block, &arrayse.post); --- 2424,2430 ---- ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr); /* If it is a more extreme value. */ ! tmp = fold_build2 (op, boolean_type_node, arrayse.expr, limit); tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt ()); gfc_add_expr_to_block (&block, tmp); gfc_add_block_to_block (&block, &arrayse.post); *************** gfc_conv_intrinsic_btest (gfc_se * se, g *** 2410,2417 **** gfc_conv_intrinsic_function_args (se, expr, args, 2); type = TREE_TYPE (args[0]); ! tmp = build2 (LSHIFT_EXPR, type, build_int_cst (type, 1), args[1]); ! tmp = build2 (BIT_AND_EXPR, type, args[0], tmp); tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp, build_int_cst (type, 0)); type = gfc_typenode_for_spec (&expr->ts); --- 2473,2480 ---- gfc_conv_intrinsic_function_args (se, expr, args, 2); type = TREE_TYPE (args[0]); ! tmp = fold_build2 (LSHIFT_EXPR, type, build_int_cst (type, 1), args[1]); ! tmp = fold_build2 (BIT_AND_EXPR, type, args[0], tmp); tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp, build_int_cst (type, 0)); type = gfc_typenode_for_spec (&expr->ts); *************** gfc_conv_intrinsic_not (gfc_se * se, gfc *** 2435,2441 **** tree arg; gfc_conv_intrinsic_function_args (se, expr, &arg, 1); ! se->expr = build1 (BIT_NOT_EXPR, TREE_TYPE (arg), arg); } /* Set or clear a single bit. */ --- 2498,2504 ---- tree arg; gfc_conv_intrinsic_function_args (se, expr, &arg, 1); ! se->expr = fold_build1 (BIT_NOT_EXPR, TREE_TYPE (arg), arg); } /* Set or clear a single bit. */ *************** gfc_conv_intrinsic_ibits (gfc_se * se, g *** 2475,2484 **** type = TREE_TYPE (args[0]); mask = build_int_cst (type, -1); ! mask = build2 (LSHIFT_EXPR, type, mask, args[2]); ! mask = build1 (BIT_NOT_EXPR, type, mask); ! tmp = build2 (RSHIFT_EXPR, type, args[0], args[1]); se->expr = fold_build2 (BIT_AND_EXPR, type, tmp, mask); } --- 2538,2547 ---- type = TREE_TYPE (args[0]); mask = build_int_cst (type, -1); ! mask = fold_build2 (LSHIFT_EXPR, type, mask, args[2]); ! mask = fold_build1 (BIT_NOT_EXPR, type, mask); ! tmp = fold_build2 (RSHIFT_EXPR, type, args[0], args[1]); se->expr = fold_build2 (BIT_AND_EXPR, type, tmp, mask); } *************** gfc_conv_intrinsic_ishft (gfc_se * se, g *** 2527,2534 **** The standard doesn't define the case of shifting negative numbers, and we try to be compatible with other compilers, most notably g77, here. */ ! rshift = fold_convert (type, build2 (RSHIFT_EXPR, utype, ! convert (utype, args[0]), width)); tmp = fold_build2 (GE_EXPR, boolean_type_node, args[1], build_int_cst (TREE_TYPE (args[1]), 0)); --- 2590,2597 ---- The standard doesn't define the case of shifting negative numbers, and we try to be compatible with other compilers, most notably g77, here. */ ! rshift = fold_convert (type, fold_build2 (RSHIFT_EXPR, utype, ! convert (utype, args[0]), width)); tmp = fold_build2 (GE_EXPR, boolean_type_node, args[1], build_int_cst (TREE_TYPE (args[1]), 0)); *************** gfc_conv_intrinsic_ishftc (gfc_se * se, *** 2559,2565 **** unsigned int num_args; num_args = gfc_intrinsic_argument_list_length (expr); ! args = alloca (sizeof (tree) * num_args); gfc_conv_intrinsic_function_args (se, expr, args, num_args); --- 2622,2628 ---- unsigned int num_args; num_args = gfc_intrinsic_argument_list_length (expr); ! args = (tree *) alloca (sizeof (tree) * num_args); gfc_conv_intrinsic_function_args (se, expr, args, num_args); *************** gfc_conv_intrinsic_ishftc (gfc_se * se, *** 2624,2629 **** --- 2687,2885 ---- se->expr = fold_build3 (COND_EXPR, type, tmp, args[0], rrot); } + /* LEADZ (i) = (i == 0) ? BIT_SIZE (i) + : __builtin_clz(i) - (BIT_SIZE('int') - BIT_SIZE(i)) + + The conditional expression is necessary because the result of LEADZ(0) + is defined, but the result of __builtin_clz(0) is undefined for most + targets. + + For INTEGER kinds smaller than the C 'int' type, we have to subtract the + difference in bit size between the argument of LEADZ and the C int. */ + + static void + gfc_conv_intrinsic_leadz (gfc_se * se, gfc_expr * expr) + { + tree arg; + tree arg_type; + tree cond; + tree result_type; + tree leadz; + tree bit_size; + tree tmp; + int arg_kind; + int i, n, s; + + gfc_conv_intrinsic_function_args (se, expr, &arg, 1); + + /* Which variant of __builtin_clz* should we call? */ + arg_kind = expr->value.function.actual->expr->ts.kind; + i = gfc_validate_kind (BT_INTEGER, arg_kind, false); + switch (arg_kind) + { + case 1: + case 2: + case 4: + arg_type = unsigned_type_node; + n = BUILT_IN_CLZ; + break; + + case 8: + arg_type = long_unsigned_type_node; + n = BUILT_IN_CLZL; + break; + + case 16: + arg_type = long_long_unsigned_type_node; + n = BUILT_IN_CLZLL; + break; + + default: + gcc_unreachable (); + } + + /* Convert the actual argument to the proper argument type for the built-in + function. But the return type is of the default INTEGER kind. */ + arg = fold_convert (arg_type, arg); + result_type = gfc_get_int_type (gfc_default_integer_kind); + + /* Compute LEADZ for the case i .ne. 0. */ + s = TYPE_PRECISION (arg_type) - gfc_integer_kinds[i].bit_size; + tmp = fold_convert (result_type, build_call_expr (built_in_decls[n], 1, arg)); + leadz = fold_build2 (MINUS_EXPR, result_type, + tmp, build_int_cst (result_type, s)); + + /* Build BIT_SIZE. */ + bit_size = build_int_cst (result_type, gfc_integer_kinds[i].bit_size); + + /* ??? For some combinations of targets and integer kinds, the condition + can be avoided if CLZ_DEFINED_VALUE_AT_ZERO is used. Later. */ + cond = fold_build2 (EQ_EXPR, boolean_type_node, + arg, build_int_cst (arg_type, 0)); + se->expr = fold_build3 (COND_EXPR, result_type, cond, bit_size, leadz); + } + + /* TRAILZ(i) = (i == 0) ? BIT_SIZE (i) : __builtin_ctz(i) + + The conditional expression is necessary because the result of TRAILZ(0) + is defined, but the result of __builtin_ctz(0) is undefined for most + targets. */ + + static void + gfc_conv_intrinsic_trailz (gfc_se * se, gfc_expr *expr) + { + tree arg; + tree arg_type; + tree cond; + tree result_type; + tree trailz; + tree bit_size; + int arg_kind; + int i, n; + + gfc_conv_intrinsic_function_args (se, expr, &arg, 1); + + /* Which variant of __builtin_clz* should we call? */ + arg_kind = expr->value.function.actual->expr->ts.kind; + i = gfc_validate_kind (BT_INTEGER, arg_kind, false); + switch (expr->ts.kind) + { + case 1: + case 2: + case 4: + arg_type = unsigned_type_node; + n = BUILT_IN_CTZ; + break; + + case 8: + arg_type = long_unsigned_type_node; + n = BUILT_IN_CTZL; + break; + + case 16: + arg_type = long_long_unsigned_type_node; + n = BUILT_IN_CTZLL; + break; + + default: + gcc_unreachable (); + } + + /* Convert the actual argument to the proper argument type for the built-in + function. But the return type is of the default INTEGER kind. */ + arg = fold_convert (arg_type, arg); + result_type = gfc_get_int_type (gfc_default_integer_kind); + + /* Compute TRAILZ for the case i .ne. 0. */ + trailz = fold_convert (result_type, build_call_expr (built_in_decls[n], 1, arg)); + + /* Build BIT_SIZE. */ + bit_size = build_int_cst (result_type, gfc_integer_kinds[i].bit_size); + + /* ??? For some combinations of targets and integer kinds, the condition + can be avoided if CTZ_DEFINED_VALUE_AT_ZERO is used. Later. */ + cond = fold_build2 (EQ_EXPR, boolean_type_node, + arg, build_int_cst (arg_type, 0)); + se->expr = fold_build3 (COND_EXPR, result_type, cond, bit_size, trailz); + } + + /* Process an intrinsic with unspecified argument-types that has an optional + argument (which could be of type character), e.g. EOSHIFT. For those, we + need to append the string length of the optional argument if it is not + present and the type is really character. + primary specifies the position (starting at 1) of the non-optional argument + specifying the type and optional gives the position of the optional + argument in the arglist. */ + + static void + conv_generic_with_optional_char_arg (gfc_se* se, gfc_expr* expr, + unsigned primary, unsigned optional) + { + gfc_actual_arglist* prim_arg; + gfc_actual_arglist* opt_arg; + unsigned cur_pos; + gfc_actual_arglist* arg; + gfc_symbol* sym; + tree append_args; + + /* Find the two arguments given as position. */ + cur_pos = 0; + prim_arg = NULL; + opt_arg = NULL; + for (arg = expr->value.function.actual; arg; arg = arg->next) + { + ++cur_pos; + + if (cur_pos == primary) + prim_arg = arg; + if (cur_pos == optional) + opt_arg = arg; + + if (cur_pos >= primary && cur_pos >= optional) + break; + } + gcc_assert (prim_arg); + gcc_assert (prim_arg->expr); + gcc_assert (opt_arg); + + /* If we do have type CHARACTER and the optional argument is really absent, + append a dummy 0 as string length. */ + append_args = NULL_TREE; + if (prim_arg->expr->ts.type == BT_CHARACTER && !opt_arg->expr) + { + tree dummy; + + dummy = build_int_cst (gfc_charlen_type_node, 0); + append_args = gfc_chainon_list (append_args, dummy); + } + + /* Build the call itself. */ + sym = gfc_get_symbol_for_expr (expr); + gfc_conv_function_call (se, sym, expr->value.function.actual, append_args); + gfc_free (sym); + } + + /* The length of a character string. */ static void gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr) *************** gfc_conv_intrinsic_len (gfc_se * se, gfc *** 2694,2705 **** static void gfc_conv_intrinsic_len_trim (gfc_se * se, gfc_expr * expr) { ! tree args[2]; ! tree type; gfc_conv_intrinsic_function_args (se, expr, args, 2); type = gfc_typenode_for_spec (&expr->ts); ! se->expr = build_call_expr (gfor_fndecl_string_len_trim, 2, args[0], args[1]); se->expr = convert (type, se->expr); } --- 2950,2969 ---- static void gfc_conv_intrinsic_len_trim (gfc_se * se, gfc_expr * expr) { ! int kind = expr->value.function.actual->expr->ts.kind; ! tree args[2], type, fndecl; gfc_conv_intrinsic_function_args (se, expr, args, 2); type = gfc_typenode_for_spec (&expr->ts); ! ! if (kind == 1) ! fndecl = gfor_fndecl_string_len_trim; ! else if (kind == 4) ! fndecl = gfor_fndecl_string_len_trim_char4; ! else ! gcc_unreachable (); ! ! se->expr = build_call_expr (fndecl, 2, args[0], args[1]); se->expr = convert (type, se->expr); } *************** gfc_conv_intrinsic_index_scan_verify (gf *** 2716,2726 **** tree *args; unsigned int num_args; ! num_args = gfc_intrinsic_argument_list_length (expr); ! args = alloca (sizeof (tree) * 5); ! gfc_conv_intrinsic_function_args (se, expr, args, ! num_args >= 5 ? 5 : num_args); type = gfc_typenode_for_spec (&expr->ts); if (num_args == 4) --- 2980,2996 ---- tree *args; unsigned int num_args; ! args = (tree *) alloca (sizeof (tree) * 5); ! /* Get number of arguments; characters count double due to the ! string length argument. Kind= is not passed to the library ! and thus ignored. */ ! if (expr->value.function.actual->next->next->expr == NULL) ! num_args = 4; ! else ! num_args = 5; ! ! gfc_conv_intrinsic_function_args (se, expr, args, num_args); type = gfc_typenode_for_spec (&expr->ts); if (num_args == 4) *************** gfc_conv_intrinsic_index_scan_verify (gf *** 2739,2750 **** static void gfc_conv_intrinsic_ichar (gfc_se * se, gfc_expr * expr) { ! tree args[2]; ! tree type; gfc_conv_intrinsic_function_args (se, expr, args, 2); gcc_assert (POINTER_TYPE_P (TREE_TYPE (args[1]))); ! args[1] = build1 (NOP_EXPR, pchar_type_node, args[1]); type = gfc_typenode_for_spec (&expr->ts); se->expr = build_fold_indirect_ref (args[1]); --- 3009,3020 ---- static void gfc_conv_intrinsic_ichar (gfc_se * se, gfc_expr * expr) { ! tree args[2], type, pchartype; gfc_conv_intrinsic_function_args (se, expr, args, 2); gcc_assert (POINTER_TYPE_P (TREE_TYPE (args[1]))); ! pchartype = gfc_get_pchar_type (expr->value.function.actual->expr->ts.kind); ! args[1] = fold_build1 (NOP_EXPR, pchartype, args[1]); type = gfc_typenode_for_spec (&expr->ts); se->expr = build_fold_indirect_ref (args[1]); *************** gfc_conv_intrinsic_merge (gfc_se * se, g *** 2790,2801 **** tree fsource; tree mask; tree type; ! tree len; tree *args; unsigned int num_args; num_args = gfc_intrinsic_argument_list_length (expr); ! args = alloca (sizeof (tree) * num_args); gfc_conv_intrinsic_function_args (se, expr, args, num_args); if (expr->ts.type != BT_CHARACTER) --- 3060,3071 ---- tree fsource; tree mask; tree type; ! tree len, len2; tree *args; unsigned int num_args; num_args = gfc_intrinsic_argument_list_length (expr); ! args = (tree *) alloca (sizeof (tree) * num_args); gfc_conv_intrinsic_function_args (se, expr, args, num_args); if (expr->ts.type != BT_CHARACTER) *************** gfc_conv_intrinsic_merge (gfc_se * se, g *** 2811,2823 **** also have to set the string length for the result. */ len = args[0]; tsource = args[1]; fsource = args[3]; mask = args[4]; se->string_length = len; } type = TREE_TYPE (tsource); ! se->expr = fold_build3 (COND_EXPR, type, mask, tsource, fsource); } --- 3081,3401 ---- also have to set the string length for the result. */ len = args[0]; tsource = args[1]; + len2 = args[2]; fsource = args[3]; mask = args[4]; + gfc_trans_same_strlen_check ("MERGE intrinsic", &expr->where, len, len2, + &se->pre); se->string_length = len; } type = TREE_TYPE (tsource); ! se->expr = fold_build3 (COND_EXPR, type, mask, tsource, ! fold_convert (type, fsource)); ! } ! ! ! /* FRACTION (s) is translated into frexp (s, &dummy_int). */ ! static void ! gfc_conv_intrinsic_fraction (gfc_se * se, gfc_expr * expr) ! { ! tree arg, type, tmp; ! int frexp; ! ! switch (expr->ts.kind) ! { ! case 4: ! frexp = BUILT_IN_FREXPF; ! break; ! case 8: ! frexp = BUILT_IN_FREXP; ! break; ! case 10: ! case 16: ! frexp = BUILT_IN_FREXPL; ! break; ! default: ! gcc_unreachable (); ! } ! ! type = gfc_typenode_for_spec (&expr->ts); ! gfc_conv_intrinsic_function_args (se, expr, &arg, 1); ! tmp = gfc_create_var (integer_type_node, NULL); ! se->expr = build_call_expr (built_in_decls[frexp], 2, ! fold_convert (type, arg), ! build_fold_addr_expr (tmp)); ! se->expr = fold_convert (type, se->expr); ! } ! ! ! /* NEAREST (s, dir) is translated into ! tmp = copysign (INF, dir); ! return nextafter (s, tmp); ! */ ! static void ! gfc_conv_intrinsic_nearest (gfc_se * se, gfc_expr * expr) ! { ! tree args[2], type, tmp; ! int nextafter, copysign, inf; ! ! switch (expr->ts.kind) ! { ! case 4: ! nextafter = BUILT_IN_NEXTAFTERF; ! copysign = BUILT_IN_COPYSIGNF; ! inf = BUILT_IN_INFF; ! break; ! case 8: ! nextafter = BUILT_IN_NEXTAFTER; ! copysign = BUILT_IN_COPYSIGN; ! inf = BUILT_IN_INF; ! break; ! case 10: ! case 16: ! nextafter = BUILT_IN_NEXTAFTERL; ! copysign = BUILT_IN_COPYSIGNL; ! inf = BUILT_IN_INFL; ! break; ! default: ! gcc_unreachable (); ! } ! ! type = gfc_typenode_for_spec (&expr->ts); ! gfc_conv_intrinsic_function_args (se, expr, args, 2); ! tmp = build_call_expr (built_in_decls[copysign], 2, ! build_call_expr (built_in_decls[inf], 0), ! fold_convert (type, args[1])); ! se->expr = build_call_expr (built_in_decls[nextafter], 2, ! fold_convert (type, args[0]), tmp); ! se->expr = fold_convert (type, se->expr); ! } ! ! ! /* SPACING (s) is translated into ! int e; ! if (s == 0) ! res = tiny; ! else ! { ! frexp (s, &e); ! e = e - prec; ! e = MAX_EXPR (e, emin); ! res = scalbn (1., e); ! } ! return res; ! ! where prec is the precision of s, gfc_real_kinds[k].digits, ! emin is min_exponent - 1, gfc_real_kinds[k].min_exponent - 1, ! and tiny is tiny(s), gfc_real_kinds[k].tiny. */ ! ! static void ! gfc_conv_intrinsic_spacing (gfc_se * se, gfc_expr * expr) ! { ! tree arg, type, prec, emin, tiny, res, e; ! tree cond, tmp; ! int frexp, scalbn, k; ! stmtblock_t block; ! ! k = gfc_validate_kind (BT_REAL, expr->ts.kind, false); ! prec = build_int_cst (NULL_TREE, gfc_real_kinds[k].digits); ! emin = build_int_cst (NULL_TREE, gfc_real_kinds[k].min_exponent - 1); ! tiny = gfc_conv_mpfr_to_tree (gfc_real_kinds[k].tiny, expr->ts.kind); ! ! switch (expr->ts.kind) ! { ! case 4: ! frexp = BUILT_IN_FREXPF; ! scalbn = BUILT_IN_SCALBNF; ! break; ! case 8: ! frexp = BUILT_IN_FREXP; ! scalbn = BUILT_IN_SCALBN; ! break; ! case 10: ! case 16: ! frexp = BUILT_IN_FREXPL; ! scalbn = BUILT_IN_SCALBNL; ! break; ! default: ! gcc_unreachable (); ! } ! ! gfc_conv_intrinsic_function_args (se, expr, &arg, 1); ! arg = gfc_evaluate_now (arg, &se->pre); ! ! type = gfc_typenode_for_spec (&expr->ts); ! e = gfc_create_var (integer_type_node, NULL); ! res = gfc_create_var (type, NULL); ! ! ! /* Build the block for s /= 0. */ ! gfc_start_block (&block); ! tmp = build_call_expr (built_in_decls[frexp], 2, arg, ! build_fold_addr_expr (e)); ! gfc_add_expr_to_block (&block, tmp); ! ! tmp = fold_build2 (MINUS_EXPR, integer_type_node, e, prec); ! gfc_add_modify (&block, e, fold_build2 (MAX_EXPR, integer_type_node, ! tmp, emin)); ! ! tmp = build_call_expr (built_in_decls[scalbn], 2, ! build_real_from_int_cst (type, integer_one_node), e); ! gfc_add_modify (&block, res, tmp); ! ! /* Finish by building the IF statement. */ ! cond = fold_build2 (EQ_EXPR, boolean_type_node, arg, ! build_real_from_int_cst (type, integer_zero_node)); ! tmp = build3_v (COND_EXPR, cond, build2_v (MODIFY_EXPR, res, tiny), ! gfc_finish_block (&block)); ! ! gfc_add_expr_to_block (&se->pre, tmp); ! se->expr = res; ! } ! ! ! /* RRSPACING (s) is translated into ! int e; ! real x; ! x = fabs (s); ! if (x != 0) ! { ! frexp (s, &e); ! x = scalbn (x, precision - e); ! } ! return x; ! ! where precision is gfc_real_kinds[k].digits. */ ! ! static void ! gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr) ! { ! tree arg, type, e, x, cond, stmt, tmp; ! int frexp, scalbn, fabs, prec, k; ! stmtblock_t block; ! ! k = gfc_validate_kind (BT_REAL, expr->ts.kind, false); ! prec = gfc_real_kinds[k].digits; ! switch (expr->ts.kind) ! { ! case 4: ! frexp = BUILT_IN_FREXPF; ! scalbn = BUILT_IN_SCALBNF; ! fabs = BUILT_IN_FABSF; ! break; ! case 8: ! frexp = BUILT_IN_FREXP; ! scalbn = BUILT_IN_SCALBN; ! fabs = BUILT_IN_FABS; ! break; ! case 10: ! case 16: ! frexp = BUILT_IN_FREXPL; ! scalbn = BUILT_IN_SCALBNL; ! fabs = BUILT_IN_FABSL; ! break; ! default: ! gcc_unreachable (); ! } ! ! type = gfc_typenode_for_spec (&expr->ts); ! gfc_conv_intrinsic_function_args (se, expr, &arg, 1); ! arg = gfc_evaluate_now (arg, &se->pre); ! ! e = gfc_create_var (integer_type_node, NULL); ! x = gfc_create_var (type, NULL); ! gfc_add_modify (&se->pre, x, ! build_call_expr (built_in_decls[fabs], 1, arg)); ! ! ! gfc_start_block (&block); ! tmp = build_call_expr (built_in_decls[frexp], 2, arg, ! build_fold_addr_expr (e)); ! gfc_add_expr_to_block (&block, tmp); ! ! tmp = fold_build2 (MINUS_EXPR, integer_type_node, ! build_int_cst (NULL_TREE, prec), e); ! tmp = build_call_expr (built_in_decls[scalbn], 2, x, tmp); ! gfc_add_modify (&block, x, tmp); ! stmt = gfc_finish_block (&block); ! ! cond = fold_build2 (NE_EXPR, boolean_type_node, x, ! build_real_from_int_cst (type, integer_zero_node)); ! tmp = build3_v (COND_EXPR, cond, stmt, build_empty_stmt ()); ! gfc_add_expr_to_block (&se->pre, tmp); ! ! se->expr = fold_convert (type, x); ! } ! ! ! /* SCALE (s, i) is translated into scalbn (s, i). */ ! static void ! gfc_conv_intrinsic_scale (gfc_se * se, gfc_expr * expr) ! { ! tree args[2], type; ! int scalbn; ! ! switch (expr->ts.kind) ! { ! case 4: ! scalbn = BUILT_IN_SCALBNF; ! break; ! case 8: ! scalbn = BUILT_IN_SCALBN; ! break; ! case 10: ! case 16: ! scalbn = BUILT_IN_SCALBNL; ! break; ! default: ! gcc_unreachable (); ! } ! ! type = gfc_typenode_for_spec (&expr->ts); ! gfc_conv_intrinsic_function_args (se, expr, args, 2); ! se->expr = build_call_expr (built_in_decls[scalbn], 2, ! fold_convert (type, args[0]), ! fold_convert (integer_type_node, args[1])); ! se->expr = fold_convert (type, se->expr); ! } ! ! ! /* SET_EXPONENT (s, i) is translated into ! scalbn (frexp (s, &dummy_int), i). */ ! static void ! gfc_conv_intrinsic_set_exponent (gfc_se * se, gfc_expr * expr) ! { ! tree args[2], type, tmp; ! int frexp, scalbn; ! ! switch (expr->ts.kind) ! { ! case 4: ! frexp = BUILT_IN_FREXPF; ! scalbn = BUILT_IN_SCALBNF; ! break; ! case 8: ! frexp = BUILT_IN_FREXP; ! scalbn = BUILT_IN_SCALBN; ! break; ! case 10: ! case 16: ! frexp = BUILT_IN_FREXPL; ! scalbn = BUILT_IN_SCALBNL; ! break; ! default: ! gcc_unreachable (); ! } ! ! type = gfc_typenode_for_spec (&expr->ts); ! gfc_conv_intrinsic_function_args (se, expr, args, 2); ! ! tmp = gfc_create_var (integer_type_node, NULL); ! tmp = build_call_expr (built_in_decls[frexp], 2, ! fold_convert (type, args[0]), ! build_fold_addr_expr (tmp)); ! se->expr = build_call_expr (built_in_decls[scalbn], 2, tmp, ! fold_convert (integer_type_node, args[1])); ! se->expr = fold_convert (type, se->expr); } *************** gfc_conv_intrinsic_size (gfc_se * se, gf *** 2856,2865 **** gfc_array_index_type); gfc_add_block_to_block (&se->pre, &argse.pre); - /* Build the call to size1. */ - fncall1 = build_call_expr (gfor_fndecl_size1, 2, - arg1, argse.expr); - /* Unusually, for an intrinsic, size does not exclude an optional arg2, so we must test for it. */ if (actual->expr->expr_type == EXPR_VARIABLE --- 3434,3439 ---- *************** gfc_conv_intrinsic_size (gfc_se * se, gf *** 2867,2894 **** && actual->expr->symtree->n.sym->attr.optional) { tree tmp; gfc_init_se (&argse, NULL); argse.want_pointer = 1; argse.data_not_needed = 1; gfc_conv_expr (&argse, actual->expr); gfc_add_block_to_block (&se->pre, &argse.pre); ! tmp = build2 (NE_EXPR, boolean_type_node, argse.expr, ! null_pointer_node); tmp = gfc_evaluate_now (tmp, &se->pre); ! se->expr = build3 (COND_EXPR, pvoid_type_node, ! tmp, fncall1, fncall0); } else ! se->expr = fncall1; } else se->expr = fncall0; type = gfc_typenode_for_spec (&expr->ts); se->expr = convert (type, se->expr); } static void gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr) { --- 3441,3514 ---- && actual->expr->symtree->n.sym->attr.optional) { tree tmp; + /* Build the call to size1. */ + fncall1 = build_call_expr (gfor_fndecl_size1, 2, + arg1, argse.expr); + gfc_init_se (&argse, NULL); argse.want_pointer = 1; argse.data_not_needed = 1; gfc_conv_expr (&argse, actual->expr); gfc_add_block_to_block (&se->pre, &argse.pre); ! tmp = fold_build2 (NE_EXPR, boolean_type_node, ! argse.expr, null_pointer_node); tmp = gfc_evaluate_now (tmp, &se->pre); ! se->expr = fold_build3 (COND_EXPR, pvoid_type_node, ! tmp, fncall1, fncall0); } else ! { ! se->expr = NULL_TREE; ! argse.expr = fold_build2 (MINUS_EXPR, gfc_array_index_type, ! argse.expr, gfc_index_one_node); ! } ! } ! else if (expr->value.function.actual->expr->rank == 1) ! { ! argse.expr = gfc_index_zero_node; ! se->expr = NULL_TREE; } else se->expr = fncall0; + if (se->expr == NULL_TREE) + { + tree ubound, lbound; + + arg1 = build_fold_indirect_ref (arg1); + ubound = gfc_conv_descriptor_ubound (arg1, argse.expr); + lbound = gfc_conv_descriptor_lbound (arg1, argse.expr); + se->expr = fold_build2 (MINUS_EXPR, gfc_array_index_type, + ubound, lbound); + se->expr = fold_build2 (PLUS_EXPR, gfc_array_index_type, se->expr, + gfc_index_one_node); + se->expr = fold_build2 (MAX_EXPR, gfc_array_index_type, se->expr, + gfc_index_zero_node); + } + type = gfc_typenode_for_spec (&expr->ts); se->expr = convert (type, se->expr); } + /* Helper function to compute the size of a character variable, + excluding the terminating null characters. The result has + gfc_array_index_type type. */ + + static tree + size_of_string_in_bytes (int kind, tree string_length) + { + tree bytesize; + int i = gfc_validate_kind (BT_CHARACTER, kind, false); + + bytesize = build_int_cst (gfc_array_index_type, + gfc_character_kinds[i].bit_size / 8); + + return fold_build2 (MULT_EXPR, gfc_array_index_type, bytesize, + fold_convert (gfc_array_index_type, string_length)); + } + + static void gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr) { *************** gfc_conv_intrinsic_sizeof (gfc_se *se, g *** 2901,2907 **** tree tmp; tree lower; tree upper; - /*tree stride;*/ int n; arg = expr->value.function.actual->expr; --- 3521,3526 ---- *************** gfc_conv_intrinsic_sizeof (gfc_se *se, g *** 2909,2916 **** gfc_init_se (&argse, NULL); ss = gfc_walk_expr (arg); - source_bytes = gfc_create_var (gfc_array_index_type, "bytes"); - if (ss == gfc_ss_terminator) { gfc_conv_expr_reference (&argse, arg); --- 3528,3533 ---- *************** gfc_conv_intrinsic_sizeof (gfc_se *se, g *** 2920,2933 **** /* Obtain the source word length. */ if (arg->ts.type == BT_CHARACTER) ! source_bytes = fold_convert (gfc_array_index_type, ! argse.string_length); else ! source_bytes = fold_convert (gfc_array_index_type, ! size_in_bytes (type)); } else { argse.want_pointer = 0; gfc_conv_expr_descriptor (&argse, arg, ss); source = gfc_conv_descriptor_data_get (argse.expr); --- 3537,3550 ---- /* Obtain the source word length. */ if (arg->ts.type == BT_CHARACTER) ! se->expr = size_of_string_in_bytes (arg->ts.kind, ! argse.string_length); else ! se->expr = fold_convert (gfc_array_index_type, size_in_bytes (type)); } else { + source_bytes = gfc_create_var (gfc_array_index_type, "bytes"); argse.want_pointer = 0; gfc_conv_expr_descriptor (&argse, arg, ss); source = gfc_conv_descriptor_data_get (argse.expr); *************** gfc_conv_intrinsic_sizeof (gfc_se *se, g *** 2935,2945 **** /* Obtain the argument's word length. */ if (arg->ts.type == BT_CHARACTER) ! tmp = fold_convert (gfc_array_index_type, argse.string_length); else tmp = fold_convert (gfc_array_index_type, size_in_bytes (type)); ! gfc_add_modify_expr (&argse.pre, source_bytes, tmp); /* Obtain the size of the array in bytes. */ for (n = 0; n < arg->rank; n++) --- 3552,3562 ---- /* Obtain the argument's word length. */ if (arg->ts.type == BT_CHARACTER) ! tmp = size_of_string_in_bytes (arg->ts.kind, argse.string_length); else tmp = fold_convert (gfc_array_index_type, size_in_bytes (type)); ! gfc_add_modify (&argse.pre, source_bytes, tmp); /* Obtain the size of the array in bytes. */ for (n = 0; n < arg->rank; n++) *************** gfc_conv_intrinsic_sizeof (gfc_se *se, g *** 2954,2965 **** tmp, gfc_index_one_node); tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, tmp, source_bytes); ! gfc_add_modify_expr (&argse.pre, source_bytes, tmp); } } gfc_add_block_to_block (&se->pre, &argse.pre); - se->expr = source_bytes; } --- 3571,3582 ---- tmp, gfc_index_one_node); tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, tmp, source_bytes); ! gfc_add_modify (&argse.pre, source_bytes, tmp); } + se->expr = source_bytes; } gfc_add_block_to_block (&se->pre, &argse.pre); } *************** gfc_conv_intrinsic_strcmp (gfc_se * se, *** 2972,2978 **** gfc_conv_intrinsic_function_args (se, expr, args, 4); ! se->expr = gfc_build_compare_string (args[0], args[1], args[2], args[3]); se->expr = fold_build2 (op, gfc_typenode_for_spec (&expr->ts), se->expr, build_int_cst (TREE_TYPE (se->expr), 0)); } --- 3589,3597 ---- gfc_conv_intrinsic_function_args (se, expr, args, 4); ! se->expr ! = gfc_build_compare_string (args[0], args[1], args[2], args[3], ! expr->value.function.actual->expr->ts.kind); se->expr = fold_build2 (op, gfc_typenode_for_spec (&expr->ts), se->expr, build_int_cst (TREE_TYPE (se->expr), 0)); } *************** gfc_conv_intrinsic_adjust (gfc_se * se, *** 3001,3018 **** } ! /* Array transfer statement. ! DEST(1:N) = TRANSFER (SOURCE, MOLD[, SIZE]) ! where: ! typeof = typeof ! and: ! N = min (sizeof (SOURCE(:)), sizeof (DEST(:)), ! sizeof (DEST(0) * SIZE). */ static void ! gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr) { tree tmp; tree extent; tree source; tree source_type; --- 3620,3646 ---- } ! /* Generate code for the TRANSFER intrinsic: ! For scalar results: ! DEST = TRANSFER (SOURCE, MOLD) ! where: ! typeof = typeof ! and: ! MOLD is scalar. + For array results: + DEST(1:N) = TRANSFER (SOURCE, MOLD[, SIZE]) + where: + typeof = typeof + and: + N = min (sizeof (SOURCE(:)), sizeof (DEST(:)), + sizeof (DEST(0) * SIZE). */ static void ! gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) { tree tmp; + tree tmpdecl; + tree ptr; tree extent; tree source; tree source_type; *************** gfc_conv_intrinsic_array_transfer (gfc_s *** 3031,3044 **** gfc_ss_info *info; stmtblock_t block; int n; ! gcc_assert (se->loop); ! info = &se->ss->data.info; /* Convert SOURCE. The output from this stage is:- source_bytes = length of the source in bytes source = pointer to the source data. */ arg = expr->value.function.actual; gfc_init_se (&argse, NULL); ss = gfc_walk_expr (arg->expr); --- 3659,3685 ---- gfc_ss_info *info; stmtblock_t block; int n; + bool scalar_mold; ! info = NULL; ! if (se->loop) ! info = &se->ss->data.info; /* Convert SOURCE. The output from this stage is:- source_bytes = length of the source in bytes source = pointer to the source data. */ arg = expr->value.function.actual; + + /* Ensure double transfer through LOGICAL preserves all + the needed bits. */ + if (arg->expr->expr_type == EXPR_FUNCTION + && arg->expr->value.function.esym == NULL + && arg->expr->value.function.isym != NULL + && arg->expr->value.function.isym->id == GFC_ISYM_TRANSFER + && arg->expr->ts.type == BT_LOGICAL + && expr->ts.type != arg->expr->ts.type) + arg->expr->value.function.name = "__transfer_in_transfer"; + gfc_init_se (&argse, NULL); ss = gfc_walk_expr (arg->expr); *************** gfc_conv_intrinsic_array_transfer (gfc_s *** 3054,3060 **** /* Obtain the source word length. */ if (arg->expr->ts.type == BT_CHARACTER) ! tmp = fold_convert (gfc_array_index_type, argse.string_length); else tmp = fold_convert (gfc_array_index_type, size_in_bytes (source_type)); --- 3695,3702 ---- /* Obtain the source word length. */ if (arg->expr->ts.type == BT_CHARACTER) ! tmp = size_of_string_in_bytes (arg->expr->ts.kind, ! argse.string_length); else tmp = fold_convert (gfc_array_index_type, size_in_bytes (source_type)); *************** gfc_conv_intrinsic_array_transfer (gfc_s *** 3067,3076 **** source_type = gfc_get_element_type (TREE_TYPE (argse.expr)); /* Repack the source if not a full variable array. */ ! if (!(arg->expr->expr_type == EXPR_VARIABLE ! && arg->expr->ref->u.ar.type == AR_FULL)) { tmp = build_fold_addr_expr (argse.expr); source = build_call_expr (gfor_fndecl_in_pack, 1, tmp); source = gfc_evaluate_now (source, &argse.pre); --- 3709,3722 ---- source_type = gfc_get_element_type (TREE_TYPE (argse.expr)); /* Repack the source if not a full variable array. */ ! if (arg->expr->expr_type == EXPR_VARIABLE ! && arg->expr->ref->u.ar.type != AR_FULL) { tmp = build_fold_addr_expr (argse.expr); + + if (gfc_option.warn_array_temp) + gfc_warning ("Creating array temporary at %L", &expr->where); + source = build_call_expr (gfor_fndecl_in_pack, 1, tmp); source = gfc_evaluate_now (source, &argse.pre); *************** gfc_conv_intrinsic_array_transfer (gfc_s *** 3083,3089 **** /* Clean up if it was repacked. */ gfc_init_block (&block); tmp = gfc_conv_array_data (argse.expr); ! tmp = build2 (NE_EXPR, boolean_type_node, source, tmp); tmp = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt ()); gfc_add_expr_to_block (&block, tmp); gfc_add_block_to_block (&block, &se->post); --- 3729,3735 ---- /* Clean up if it was repacked. */ gfc_init_block (&block); tmp = gfc_conv_array_data (argse.expr); ! tmp = fold_build2 (NE_EXPR, boolean_type_node, source, tmp); tmp = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt ()); gfc_add_expr_to_block (&block, tmp); gfc_add_block_to_block (&block, &se->post); *************** gfc_conv_intrinsic_array_transfer (gfc_s *** 3093,3099 **** /* Obtain the source word length. */ if (arg->expr->ts.type == BT_CHARACTER) ! tmp = fold_convert (gfc_array_index_type, argse.string_length); else tmp = fold_convert (gfc_array_index_type, size_in_bytes (source_type)); --- 3739,3746 ---- /* Obtain the source word length. */ if (arg->expr->ts.type == BT_CHARACTER) ! tmp = size_of_string_in_bytes (arg->expr->ts.kind, ! argse.string_length); else tmp = fold_convert (gfc_array_index_type, size_in_bytes (source_type)); *************** gfc_conv_intrinsic_array_transfer (gfc_s *** 3104,3116 **** { tree idx; idx = gfc_rank_cst[n]; ! gfc_add_modify_expr (&argse.pre, source_bytes, tmp); stride = gfc_conv_descriptor_stride (argse.expr, idx); lower = gfc_conv_descriptor_lbound (argse.expr, idx); upper = gfc_conv_descriptor_ubound (argse.expr, idx); tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, upper, lower); ! gfc_add_modify_expr (&argse.pre, extent, tmp); tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, extent, gfc_index_one_node); tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, --- 3751,3763 ---- { tree idx; idx = gfc_rank_cst[n]; ! gfc_add_modify (&argse.pre, source_bytes, tmp); stride = gfc_conv_descriptor_stride (argse.expr, idx); lower = gfc_conv_descriptor_lbound (argse.expr, idx); upper = gfc_conv_descriptor_ubound (argse.expr, idx); tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, upper, lower); ! gfc_add_modify (&argse.pre, extent, tmp); tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, extent, gfc_index_one_node); tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, *************** gfc_conv_intrinsic_array_transfer (gfc_s *** 3118,3124 **** } } ! gfc_add_modify_expr (&argse.pre, source_bytes, tmp); gfc_add_block_to_block (&se->pre, &argse.pre); gfc_add_block_to_block (&se->post, &argse.post); --- 3765,3771 ---- } } ! gfc_add_modify (&argse.pre, source_bytes, tmp); gfc_add_block_to_block (&se->pre, &argse.pre); gfc_add_block_to_block (&se->post, &argse.post); *************** gfc_conv_intrinsic_array_transfer (gfc_s *** 3130,3135 **** --- 3777,3784 ---- gfc_init_se (&argse, NULL); ss = gfc_walk_expr (arg->expr); + scalar_mold = arg->expr->rank == 0; + if (ss == gfc_ss_terminator) { gfc_conv_expr_reference (&argse, arg->expr); *************** gfc_conv_intrinsic_array_transfer (gfc_s *** 3143,3151 **** mold_type = gfc_get_element_type (TREE_TYPE (argse.expr)); } if (arg->expr->ts.type == BT_CHARACTER) { ! tmp = fold_convert (gfc_array_index_type, argse.string_length); mold_type = gfc_get_character_type_len (arg->expr->ts.kind, tmp); } else --- 3792,3811 ---- mold_type = gfc_get_element_type (TREE_TYPE (argse.expr)); } + gfc_add_block_to_block (&se->pre, &argse.pre); + gfc_add_block_to_block (&se->post, &argse.post); + + if (strcmp (expr->value.function.name, "__transfer_in_transfer") == 0) + { + /* If this TRANSFER is nested in another TRANSFER, use a type + that preserves all bits. */ + if (arg->expr->ts.type == BT_LOGICAL) + mold_type = gfc_get_int_type (arg->expr->ts.kind); + } + if (arg->expr->ts.type == BT_CHARACTER) { ! tmp = size_of_string_in_bytes (arg->expr->ts.kind, argse.string_length); mold_type = gfc_get_character_type_len (arg->expr->ts.kind, tmp); } else *************** gfc_conv_intrinsic_array_transfer (gfc_s *** 3153,3159 **** size_in_bytes (mold_type)); dest_word_len = gfc_create_var (gfc_array_index_type, NULL); ! gfc_add_modify_expr (&se->pre, dest_word_len, tmp); /* Finally convert SIZE, if it is present. */ arg = arg->next; --- 3813,3819 ---- size_in_bytes (mold_type)); dest_word_len = gfc_create_var (gfc_array_index_type, NULL); ! gfc_add_modify (&se->pre, dest_word_len, tmp); /* Finally convert SIZE, if it is present. */ arg = arg->next; *************** gfc_conv_intrinsic_array_transfer (gfc_s *** 3171,3189 **** else tmp = NULL_TREE; size_bytes = gfc_create_var (gfc_array_index_type, NULL); if (tmp != NULL_TREE) ! { ! tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, ! tmp, dest_word_len); ! tmp = fold_build2 (MIN_EXPR, gfc_array_index_type, ! tmp, source_bytes); ! } else tmp = source_bytes; ! gfc_add_modify_expr (&se->pre, size_bytes, tmp); ! gfc_add_modify_expr (&se->pre, size_words, fold_build2 (CEIL_DIV_EXPR, gfc_array_index_type, size_bytes, dest_word_len)); --- 3831,3849 ---- else tmp = NULL_TREE; + /* Separate array and scalar results. */ + if (scalar_mold && tmp == NULL_TREE) + goto scalar_transfer; + size_bytes = gfc_create_var (gfc_array_index_type, NULL); if (tmp != NULL_TREE) ! tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, ! tmp, dest_word_len); else tmp = source_bytes; ! gfc_add_modify (&se->pre, size_bytes, tmp); ! gfc_add_modify (&se->pre, size_words, fold_build2 (CEIL_DIV_EXPR, gfc_array_index_type, size_bytes, dest_word_len)); *************** gfc_conv_intrinsic_array_transfer (gfc_s *** 3200,3207 **** tmp, gfc_index_one_node); tmp = fold_build2 (MIN_EXPR, gfc_array_index_type, tmp, size_words); ! gfc_add_modify_expr (&se->pre, size_words, tmp); ! gfc_add_modify_expr (&se->pre, size_bytes, fold_build2 (MULT_EXPR, gfc_array_index_type, size_words, dest_word_len)); upper = fold_build2 (PLUS_EXPR, gfc_array_index_type, --- 3860,3867 ---- tmp, gfc_index_one_node); tmp = fold_build2 (MIN_EXPR, gfc_array_index_type, tmp, size_words); ! gfc_add_modify (&se->pre, size_words, tmp); ! gfc_add_modify (&se->pre, size_bytes, fold_build2 (MULT_EXPR, gfc_array_index_type, size_words, dest_word_len)); upper = fold_build2 (PLUS_EXPR, gfc_array_index_type, *************** gfc_conv_intrinsic_array_transfer (gfc_s *** 3219,3229 **** se->loop->to[n] = upper; /* Build a destination descriptor, using the pointer, source, as the ! data field. This is already allocated so set callee_alloc. ! FIXME callee_alloc is not set! */ ! gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, ! info, mold_type, false, true, false); /* Cast the pointer to the result. */ tmp = gfc_conv_descriptor_data_get (info->descriptor); --- 3879,3888 ---- se->loop->to[n] = upper; /* Build a destination descriptor, using the pointer, source, as the ! data field. */ gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, ! info, mold_type, NULL_TREE, false, true, false, ! &expr->where); /* Cast the pointer to the result. */ tmp = gfc_conv_descriptor_data_get (info->descriptor); *************** gfc_conv_intrinsic_array_transfer (gfc_s *** 3234,3298 **** 3, tmp, fold_convert (pvoid_type_node, source), ! size_bytes); gfc_add_expr_to_block (&se->pre, tmp); se->expr = info->descriptor; if (expr->ts.type == BT_CHARACTER) se->string_length = dest_word_len; - } ! /* Scalar transfer statement. ! TRANSFER (source, mold) = memcpy(&tmpdecl, &source, size), tmpdecl. */ ! static void ! gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) ! { ! gfc_actual_arglist *arg; ! gfc_se argse; ! tree type; ! tree ptr; ! gfc_ss *ss; ! tree tmpdecl, tmp; ! /* Get a pointer to the source. */ ! arg = expr->value.function.actual; ! ss = gfc_walk_expr (arg->expr); ! gfc_init_se (&argse, NULL); ! if (ss == gfc_ss_terminator) ! gfc_conv_expr_reference (&argse, arg->expr); ! else ! gfc_conv_array_parameter (&argse, arg->expr, ss, 1, NULL); ! gfc_add_block_to_block (&se->pre, &argse.pre); ! gfc_add_block_to_block (&se->post, &argse.post); ! ptr = argse.expr; ! arg = arg->next; ! type = gfc_typenode_for_spec (&expr->ts); ! if (expr->ts.type == BT_CHARACTER) ! { ! ptr = convert (build_pointer_type (type), ptr); ! gfc_init_se (&argse, NULL); ! gfc_conv_expr (&argse, arg->expr); ! gfc_add_block_to_block (&se->pre, &argse.pre); ! gfc_add_block_to_block (&se->post, &argse.post); ! se->expr = ptr; ! se->string_length = argse.string_length; } else { ! tree moldsize; ! tmpdecl = gfc_create_var (type, "transfer"); ! moldsize = size_in_bytes (type); /* Use memcpy to do the transfer. */ ! tmp = build1 (ADDR_EXPR, build_pointer_type (type), tmpdecl); tmp = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3, fold_convert (pvoid_type_node, tmp), fold_convert (pvoid_type_node, ptr), ! moldsize); gfc_add_expr_to_block (&se->pre, tmp); se->expr = tmpdecl; --- 3893,3963 ---- 3, tmp, fold_convert (pvoid_type_node, source), ! fold_build2 (MIN_EXPR, gfc_array_index_type, ! size_bytes, source_bytes)); gfc_add_expr_to_block (&se->pre, tmp); se->expr = info->descriptor; if (expr->ts.type == BT_CHARACTER) se->string_length = dest_word_len; + return; ! /* Deal with scalar results. */ ! scalar_transfer: ! extent = fold_build2 (MIN_EXPR, gfc_array_index_type, ! dest_word_len, source_bytes); ! if (expr->ts.type == BT_CHARACTER) ! { ! tree direct; ! tree indirect; ! ptr = convert (gfc_get_pchar_type (expr->ts.kind), source); ! tmpdecl = gfc_create_var (gfc_get_pchar_type (expr->ts.kind), ! "transfer"); ! /* If source is longer than the destination, use a pointer to ! the source directly. */ ! gfc_init_block (&block); ! gfc_add_modify (&block, tmpdecl, ptr); ! direct = gfc_finish_block (&block); ! /* Otherwise, allocate a string with the length of the destination ! and copy the source into it. */ ! gfc_init_block (&block); ! tmp = gfc_get_pchar_type (expr->ts.kind); ! tmp = gfc_call_malloc (&block, tmp, dest_word_len); ! gfc_add_modify (&block, tmpdecl, ! fold_convert (TREE_TYPE (ptr), tmp)); ! tmp = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3, ! fold_convert (pvoid_type_node, tmpdecl), ! fold_convert (pvoid_type_node, ptr), ! extent); ! gfc_add_expr_to_block (&block, tmp); ! indirect = gfc_finish_block (&block); ! ! /* Wrap it up with the condition. */ ! tmp = fold_build2 (LE_EXPR, boolean_type_node, ! dest_word_len, source_bytes); ! tmp = build3_v (COND_EXPR, tmp, direct, indirect); ! gfc_add_expr_to_block (&se->pre, tmp); ! ! se->expr = tmpdecl; ! se->string_length = dest_word_len; } else { ! tmpdecl = gfc_create_var (mold_type, "transfer"); ! ! ptr = convert (build_pointer_type (mold_type), source); /* Use memcpy to do the transfer. */ ! tmp = build_fold_addr_expr (tmpdecl); tmp = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3, fold_convert (pvoid_type_node, tmp), fold_convert (pvoid_type_node, ptr), ! extent); gfc_add_expr_to_block (&se->pre, tmp); se->expr = tmpdecl; *************** gfc_conv_allocated (gfc_se *se, gfc_expr *** 3318,3325 **** gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1); tmp = gfc_conv_descriptor_data_get (arg1se.expr); ! tmp = build2 (NE_EXPR, boolean_type_node, tmp, ! fold_convert (TREE_TYPE (tmp), null_pointer_node)); se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp); } --- 3983,3990 ---- gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1); tmp = gfc_conv_descriptor_data_get (arg1se.expr); ! tmp = fold_build2 (NE_EXPR, boolean_type_node, ! tmp, fold_convert (TREE_TYPE (tmp), null_pointer_node)); se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp); } *************** gfc_conv_associated (gfc_se *se, gfc_exp *** 3367,3374 **** } gfc_add_block_to_block (&se->pre, &arg1se.pre); gfc_add_block_to_block (&se->post, &arg1se.post); ! tmp = build2 (NE_EXPR, boolean_type_node, tmp2, ! fold_convert (TREE_TYPE (tmp2), null_pointer_node)); se->expr = tmp; } else --- 4032,4039 ---- } gfc_add_block_to_block (&se->pre, &arg1se.pre); gfc_add_block_to_block (&se->post, &arg1se.post); ! tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp2, ! fold_convert (TREE_TYPE (tmp2), null_pointer_node)); se->expr = tmp; } else *************** gfc_conv_associated (gfc_se *se, gfc_exp *** 3378,3386 **** nonzero_charlen = NULL_TREE; if (arg1->expr->ts.type == BT_CHARACTER) ! nonzero_charlen = build2 (NE_EXPR, boolean_type_node, ! arg1->expr->ts.cl->backend_decl, ! integer_zero_node); if (ss1 == gfc_ss_terminator) { --- 4043,4051 ---- nonzero_charlen = NULL_TREE; if (arg1->expr->ts.type == BT_CHARACTER) ! nonzero_charlen = fold_build2 (NE_EXPR, boolean_type_node, ! arg1->expr->ts.cl->backend_decl, ! integer_zero_node); if (ss1 == gfc_ss_terminator) { *************** gfc_conv_associated (gfc_se *se, gfc_exp *** 3392,3401 **** gfc_conv_expr (&arg2se, arg2->expr); gfc_add_block_to_block (&se->pre, &arg1se.pre); gfc_add_block_to_block (&se->post, &arg1se.post); ! tmp = build2 (EQ_EXPR, boolean_type_node, arg1se.expr, arg2se.expr); ! tmp2 = build2 (NE_EXPR, boolean_type_node, arg1se.expr, ! null_pointer_node); ! se->expr = build2 (TRUTH_AND_EXPR, boolean_type_node, tmp, tmp2); } else { --- 4057,4068 ---- gfc_conv_expr (&arg2se, arg2->expr); gfc_add_block_to_block (&se->pre, &arg1se.pre); gfc_add_block_to_block (&se->post, &arg1se.post); ! tmp = fold_build2 (EQ_EXPR, boolean_type_node, ! arg1se.expr, arg2se.expr); ! tmp2 = fold_build2 (NE_EXPR, boolean_type_node, ! arg1se.expr, null_pointer_node); ! se->expr = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, ! tmp, tmp2); } else { *************** gfc_conv_associated (gfc_se *se, gfc_exp *** 3405,3412 **** gfc_conv_expr_lhs (&arg1se, arg1->expr); tmp = gfc_conv_descriptor_stride (arg1se.expr, gfc_rank_cst[arg1->expr->rank - 1]); ! nonzero_arraylen = build2 (NE_EXPR, boolean_type_node, ! tmp, build_int_cst (TREE_TYPE (tmp), 0)); /* A pointer to an array, call library function _gfor_associated. */ gcc_assert (ss2 != gfc_ss_terminator); --- 4072,4079 ---- gfc_conv_expr_lhs (&arg1se, arg1->expr); tmp = gfc_conv_descriptor_stride (arg1se.expr, gfc_rank_cst[arg1->expr->rank - 1]); ! nonzero_arraylen = fold_build2 (NE_EXPR, boolean_type_node, tmp, ! build_int_cst (TREE_TYPE (tmp), 0)); /* A pointer to an array, call library function _gfor_associated. */ gcc_assert (ss2 != gfc_ss_terminator); *************** gfc_conv_associated (gfc_se *se, gfc_exp *** 3420,3440 **** se->expr = build_call_expr (gfor_fndecl_associated, 2, arg1se.expr, arg2se.expr); se->expr = convert (boolean_type_node, se->expr); ! se->expr = build2 (TRUTH_AND_EXPR, boolean_type_node, ! se->expr, nonzero_arraylen); } /* If target is present zero character length pointers cannot be associated. */ if (nonzero_charlen != NULL_TREE) ! se->expr = build2 (TRUTH_AND_EXPR, boolean_type_node, ! se->expr, nonzero_charlen); } se->expr = convert (gfc_typenode_for_spec (&expr->ts), se->expr); } /* Generate code for SELECTED_INT_KIND (R) intrinsic function. */ static void --- 4087,4120 ---- se->expr = build_call_expr (gfor_fndecl_associated, 2, arg1se.expr, arg2se.expr); se->expr = convert (boolean_type_node, se->expr); ! se->expr = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, ! se->expr, nonzero_arraylen); } /* If target is present zero character length pointers cannot be associated. */ if (nonzero_charlen != NULL_TREE) ! se->expr = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, ! se->expr, nonzero_charlen); } se->expr = convert (gfc_typenode_for_spec (&expr->ts), se->expr); } + /* Generate code for SELECTED_CHAR_KIND (NAME) intrinsic function. */ + + static void + gfc_conv_intrinsic_sc_kind (gfc_se *se, gfc_expr *expr) + { + tree args[2]; + + gfc_conv_intrinsic_function_args (se, expr, args, 2); + se->expr = build_call_expr (gfor_fndecl_sc_kind, 2, args[0], args[1]); + se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), se->expr); + } + + /* Generate code for SELECTED_INT_KIND (R) intrinsic function. */ static void *************** gfc_conv_intrinsic_sr_kind (gfc_se *se, *** 3475,3480 **** --- 4155,4162 ---- else { gfc_typespec ts; + gfc_clear_ts (&ts); + if (actual->expr->ts.kind != gfc_c_int_kind) { /* The arguments to SELECTED_REAL_KIND are INTEGER(4). */ *************** gfc_conv_intrinsic_sr_kind (gfc_se *se, *** 3502,3538 **** static void gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr) { - tree gfc_int4_type_node = gfc_get_int_type (4); tree var; tree len; tree addr; tree tmp; - tree type; tree cond; tree fndecl; tree *args; unsigned int num_args; num_args = gfc_intrinsic_argument_list_length (expr) + 2; ! args = alloca (sizeof (tree) * num_args); ! type = build_pointer_type (gfc_character1_type_node); ! var = gfc_create_var (type, "pstr"); addr = gfc_build_addr_expr (ppvoid_type_node, var); ! len = gfc_create_var (gfc_int4_type_node, "len"); gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2); args[0] = build_fold_addr_expr (len); args[1] = addr; ! fndecl = build_addr (gfor_fndecl_string_trim, current_function_decl); ! tmp = build_call_array (TREE_TYPE (TREE_TYPE (gfor_fndecl_string_trim)), ! fndecl, num_args, args); gfc_add_expr_to_block (&se->pre, tmp); /* Free the temporary afterwards, if necessary. */ ! cond = build2 (GT_EXPR, boolean_type_node, len, ! build_int_cst (TREE_TYPE (len), 0)); tmp = gfc_call_free (var); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); gfc_add_expr_to_block (&se->post, tmp); --- 4184,4225 ---- static void gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr) { tree var; tree len; tree addr; tree tmp; tree cond; tree fndecl; + tree function; tree *args; unsigned int num_args; num_args = gfc_intrinsic_argument_list_length (expr) + 2; ! args = (tree *) alloca (sizeof (tree) * num_args); ! var = gfc_create_var (gfc_get_pchar_type (expr->ts.kind), "pstr"); addr = gfc_build_addr_expr (ppvoid_type_node, var); ! len = gfc_create_var (gfc_get_int_type (4), "len"); gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2); args[0] = build_fold_addr_expr (len); args[1] = addr; ! if (expr->ts.kind == 1) ! function = gfor_fndecl_string_trim; ! else if (expr->ts.kind == 4) ! function = gfor_fndecl_string_trim_char4; ! else ! gcc_unreachable (); ! ! fndecl = build_addr (function, current_function_decl); ! tmp = build_call_array (TREE_TYPE (TREE_TYPE (function)), fndecl, ! num_args, args); gfc_add_expr_to_block (&se->pre, tmp); /* Free the temporary afterwards, if necessary. */ ! cond = fold_build2 (GT_EXPR, boolean_type_node, ! len, build_int_cst (TREE_TYPE (len), 0)); tmp = gfc_call_free (var); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); gfc_add_expr_to_block (&se->post, tmp); *************** gfc_conv_intrinsic_repeat (gfc_se * se, *** 3549,3557 **** --- 4236,4249 ---- { tree args[3], ncopies, dest, dlen, src, slen, ncopies_type; tree type, cond, tmp, count, exit_label, n, max, largest; + tree size; stmtblock_t block, body; int i; + /* We store in charsize the size of a character. */ + i = gfc_validate_kind (BT_CHARACTER, expr->ts.kind, false); + size = build_int_cst (size_type_node, gfc_character_kinds[i].bit_size / 8); + /* Get the arguments. */ gfc_conv_intrinsic_function_args (se, expr, args, 3); slen = fold_convert (size_type_node, gfc_evaluate_now (args[0], &se->pre)); *************** gfc_conv_intrinsic_repeat (gfc_se * se, *** 3562,3568 **** /* Check that NCOPIES is not negative. */ cond = fold_build2 (LT_EXPR, boolean_type_node, ncopies, build_int_cst (ncopies_type, 0)); ! gfc_trans_runtime_check (cond, &se->pre, &expr->where, "Argument NCOPIES of REPEAT intrinsic is negative " "(its value is %lld)", fold_convert (long_integer_type_node, ncopies)); --- 4254,4260 ---- /* Check that NCOPIES is not negative. */ cond = fold_build2 (LT_EXPR, boolean_type_node, ncopies, build_int_cst (ncopies_type, 0)); ! gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where, "Argument NCOPIES of REPEAT intrinsic is negative " "(its value is %lld)", fold_convert (long_integer_type_node, ncopies)); *************** gfc_conv_intrinsic_repeat (gfc_se * se, *** 3574,3580 **** build_int_cst (size_type_node, 0)); tmp = fold_build3 (COND_EXPR, ncopies_type, cond, build_int_cst (ncopies_type, 0), ncopies); ! gfc_add_modify_expr (&se->pre, n, tmp); ncopies = n; /* Check that ncopies is not too large: ncopies should be less than --- 4266,4272 ---- build_int_cst (size_type_node, 0)); tmp = fold_build3 (COND_EXPR, ncopies_type, cond, build_int_cst (ncopies_type, 0), ncopies); ! gfc_add_modify (&se->pre, n, tmp); ncopies = n; /* Check that ncopies is not too large: ncopies should be less than *************** gfc_conv_intrinsic_repeat (gfc_se * se, *** 3594,3602 **** build_int_cst (size_type_node, 0)); cond = fold_build3 (COND_EXPR, boolean_type_node, tmp, boolean_false_node, cond); ! gfc_trans_runtime_check (cond, &se->pre, &expr->where, "Argument NCOPIES of REPEAT intrinsic is too large"); - /* Compute the destination length. */ dlen = fold_build2 (MULT_EXPR, gfc_charlen_type_node, --- 4286,4293 ---- build_int_cst (size_type_node, 0)); cond = fold_build3 (COND_EXPR, boolean_type_node, tmp, boolean_false_node, cond); ! gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where, "Argument NCOPIES of REPEAT intrinsic is too large"); /* Compute the destination length. */ dlen = fold_build2 (MULT_EXPR, gfc_charlen_type_node, *************** gfc_conv_intrinsic_repeat (gfc_se * se, *** 3607,3616 **** /* Generate the code to do the repeat operation: for (i = 0; i < ncopies; i++) ! memmove (dest + (i * slen), src, slen); */ gfc_start_block (&block); count = gfc_create_var (ncopies_type, "count"); ! gfc_add_modify_expr (&block, count, build_int_cst (ncopies_type, 0)); exit_label = gfc_build_label_decl (NULL_TREE); /* Start the loop body. */ --- 4298,4307 ---- /* Generate the code to do the repeat operation: for (i = 0; i < ncopies; i++) ! memmove (dest + (i * slen * size), src, slen*size); */ gfc_start_block (&block); count = gfc_create_var (ncopies_type, "count"); ! gfc_add_modify (&block, count, build_int_cst (ncopies_type, 0)); exit_label = gfc_build_label_decl (NULL_TREE); /* Start the loop body. */ *************** gfc_conv_intrinsic_repeat (gfc_se * se, *** 3624,3644 **** build_empty_stmt ()); gfc_add_expr_to_block (&body, tmp); ! /* Call memmove (dest + (i*slen), src, slen). */ tmp = fold_build2 (MULT_EXPR, gfc_charlen_type_node, fold_convert (gfc_charlen_type_node, slen), fold_convert (gfc_charlen_type_node, count)); ! tmp = fold_build2 (POINTER_PLUS_EXPR, pchar_type_node, ! fold_convert (pchar_type_node, dest), fold_convert (sizetype, tmp)); ! tmp = build_call_expr (built_in_decls[BUILT_IN_MEMMOVE], 3, ! tmp, src, slen); gfc_add_expr_to_block (&body, tmp); /* Increment count. */ ! tmp = build2 (PLUS_EXPR, ncopies_type, count, ! build_int_cst (TREE_TYPE (count), 1)); ! gfc_add_modify_expr (&body, count, tmp); /* Build the loop. */ tmp = build1_v (LOOP_EXPR, gfc_finish_block (&body)); --- 4315,4338 ---- build_empty_stmt ()); gfc_add_expr_to_block (&body, tmp); ! /* Call memmove (dest + (i*slen*size), src, slen*size). */ tmp = fold_build2 (MULT_EXPR, gfc_charlen_type_node, fold_convert (gfc_charlen_type_node, slen), fold_convert (gfc_charlen_type_node, count)); ! tmp = fold_build2 (MULT_EXPR, gfc_charlen_type_node, ! tmp, fold_convert (gfc_charlen_type_node, size)); ! tmp = fold_build2 (POINTER_PLUS_EXPR, pvoid_type_node, ! fold_convert (pvoid_type_node, dest), fold_convert (sizetype, tmp)); ! tmp = build_call_expr (built_in_decls[BUILT_IN_MEMMOVE], 3, tmp, src, ! fold_build2 (MULT_EXPR, size_type_node, slen, ! fold_convert (size_type_node, size))); gfc_add_expr_to_block (&body, tmp); /* Increment count. */ ! tmp = fold_build2 (PLUS_EXPR, ncopies_type, ! count, build_int_cst (TREE_TYPE (count), 1)); ! gfc_add_modify (&body, count, tmp); /* Build the loop. */ tmp = build1_v (LOOP_EXPR, gfc_finish_block (&body)); *************** gfc_conv_intrinsic_loc (gfc_se * se, gfc *** 3696,3708 **** if (ss == gfc_ss_terminator) gfc_conv_expr_reference (se, arg_expr); else ! gfc_conv_array_parameter (se, arg_expr, ss, 1, NULL); se->expr= convert (gfc_get_int_type (gfc_index_integer_kind), se->expr); /* Create a temporary variable for loc return value. Without this, we get an error an ICE in gcc/expr.c(expand_expr_addr_expr_1). */ temp_var = gfc_create_var (gfc_get_int_type (gfc_index_integer_kind), NULL); ! gfc_add_modify_expr (&se->pre, temp_var, se->expr); se->expr = temp_var; } --- 4390,4402 ---- if (ss == gfc_ss_terminator) gfc_conv_expr_reference (se, arg_expr); else ! gfc_conv_array_parameter (se, arg_expr, ss, 1, NULL, NULL); se->expr= convert (gfc_get_int_type (gfc_index_integer_kind), se->expr); /* Create a temporary variable for loc return value. Without this, we get an error an ICE in gcc/expr.c(expand_expr_addr_expr_1). */ temp_var = gfc_create_var (gfc_get_int_type (gfc_index_integer_kind), NULL); ! gfc_add_modify (&se->pre, temp_var, se->expr); se->expr = temp_var; } *************** gfc_conv_intrinsic_function (gfc_se * se *** 3715,3721 **** { gfc_intrinsic_sym *isym; const char *name; ! int lib; isym = expr->value.function.isym; --- 4409,4416 ---- { gfc_intrinsic_sym *isym; const char *name; ! int lib, kind; ! tree fndecl; isym = expr->value.function.isym; *************** gfc_conv_intrinsic_function (gfc_se * se *** 3728,3734 **** { if (lib == 1) se->ignore_optional = 1; ! gfc_conv_intrinsic_funcall (se, expr); return; } } --- 4423,4444 ---- { if (lib == 1) se->ignore_optional = 1; ! ! switch (expr->value.function.isym->id) ! { ! case GFC_ISYM_EOSHIFT: ! case GFC_ISYM_PACK: ! case GFC_ISYM_RESHAPE: ! /* For all of those the first argument specifies the type and the ! third is optional. */ ! conv_generic_with_optional_char_arg (se, expr, 1, 3); ! break; ! ! default: ! gfc_conv_intrinsic_funcall (se, expr); ! break; ! } ! return; } } *************** gfc_conv_intrinsic_function (gfc_se * se *** 3746,3751 **** --- 4456,4465 ---- gfc_conv_intrinsic_trim (se, expr); break; + case GFC_ISYM_SC_KIND: + gfc_conv_intrinsic_sc_kind (se, expr); + break; + case GFC_ISYM_SI_KIND: gfc_conv_intrinsic_si_kind (se, expr); break; *************** gfc_conv_intrinsic_function (gfc_se * se *** 3759,3769 **** break; case GFC_ISYM_SCAN: ! gfc_conv_intrinsic_index_scan_verify (se, expr, gfor_fndecl_string_scan); break; case GFC_ISYM_VERIFY: ! gfc_conv_intrinsic_index_scan_verify (se, expr, gfor_fndecl_string_verify); break; case GFC_ISYM_ALLOCATED: --- 4473,4499 ---- break; case GFC_ISYM_SCAN: ! kind = expr->value.function.actual->expr->ts.kind; ! if (kind == 1) ! fndecl = gfor_fndecl_string_scan; ! else if (kind == 4) ! fndecl = gfor_fndecl_string_scan_char4; ! else ! gcc_unreachable (); ! ! gfc_conv_intrinsic_index_scan_verify (se, expr, fndecl); break; case GFC_ISYM_VERIFY: ! kind = expr->value.function.actual->expr->ts.kind; ! if (kind == 1) ! fndecl = gfor_fndecl_string_verify; ! else if (kind == 4) ! fndecl = gfor_fndecl_string_verify_char4; ! else ! gcc_unreachable (); ! ! gfc_conv_intrinsic_index_scan_verify (se, expr, fndecl); break; case GFC_ISYM_ALLOCATED: *************** gfc_conv_intrinsic_function (gfc_se * se *** 3779,3789 **** break; case GFC_ISYM_ADJUSTL: ! gfc_conv_intrinsic_adjust (se, expr, gfor_fndecl_adjustl); break; case GFC_ISYM_ADJUSTR: ! gfc_conv_intrinsic_adjust (se, expr, gfor_fndecl_adjustr); break; case GFC_ISYM_AIMAG: --- 4509,4533 ---- break; case GFC_ISYM_ADJUSTL: ! if (expr->ts.kind == 1) ! fndecl = gfor_fndecl_adjustl; ! else if (expr->ts.kind == 4) ! fndecl = gfor_fndecl_adjustl_char4; ! else ! gcc_unreachable (); ! ! gfc_conv_intrinsic_adjust (se, expr, fndecl); break; case GFC_ISYM_ADJUSTR: ! if (expr->ts.kind == 1) ! fndecl = gfor_fndecl_adjustr; ! else if (expr->ts.kind == 4) ! fndecl = gfor_fndecl_adjustr_char4; ! else ! gcc_unreachable (); ! ! gfc_conv_intrinsic_adjust (se, expr, fndecl); break; case GFC_ISYM_AIMAG: *************** gfc_conv_intrinsic_function (gfc_se * se *** 3895,3900 **** --- 4639,4648 ---- gfc_conv_intrinsic_fdate (se, expr); break; + case GFC_ISYM_FRACTION: + gfc_conv_intrinsic_fraction (se, expr); + break; + case GFC_ISYM_IAND: gfc_conv_intrinsic_bitop (se, expr, BIT_AND_EXPR); break; *************** gfc_conv_intrinsic_function (gfc_se * se *** 3926,3932 **** break; case GFC_ISYM_INDEX: ! gfc_conv_intrinsic_index_scan_verify (se, expr, gfor_fndecl_string_index); break; case GFC_ISYM_IOR: --- 4674,4688 ---- break; case GFC_ISYM_INDEX: ! kind = expr->value.function.actual->expr->ts.kind; ! if (kind == 1) ! fndecl = gfor_fndecl_string_index; ! else if (kind == 4) ! fndecl = gfor_fndecl_string_index_char4; ! else ! gcc_unreachable (); ! ! gfc_conv_intrinsic_index_scan_verify (se, expr, fndecl); break; case GFC_ISYM_IOR: *************** gfc_conv_intrinsic_function (gfc_se * se *** 3961,3966 **** --- 4717,4730 ---- gfc_conv_intrinsic_ishftc (se, expr); break; + case GFC_ISYM_LEADZ: + gfc_conv_intrinsic_leadz (se, expr); + break; + + case GFC_ISYM_TRAILZ: + gfc_conv_intrinsic_trailz (se, expr); + break; + case GFC_ISYM_LBOUND: gfc_conv_intrinsic_bound (se, expr, 0); break; *************** gfc_conv_intrinsic_function (gfc_se * se *** 4033,4038 **** --- 4797,4806 ---- gfc_conv_intrinsic_minmaxval (se, expr, LT_EXPR); break; + case GFC_ISYM_NEAREST: + gfc_conv_intrinsic_nearest (se, expr); + break; + case GFC_ISYM_NOT: gfc_conv_intrinsic_not (se, expr); break; *************** gfc_conv_intrinsic_function (gfc_se * se *** 4049,4054 **** --- 4817,4834 ---- gfc_conv_intrinsic_arith (se, expr, MULT_EXPR); break; + case GFC_ISYM_RRSPACING: + gfc_conv_intrinsic_rrspacing (se, expr); + break; + + case GFC_ISYM_SET_EXPONENT: + gfc_conv_intrinsic_set_exponent (se, expr); + break; + + case GFC_ISYM_SCALE: + gfc_conv_intrinsic_scale (se, expr); + break; + case GFC_ISYM_SIGN: gfc_conv_intrinsic_sign (se, expr); break; *************** gfc_conv_intrinsic_function (gfc_se * se *** 4061,4082 **** gfc_conv_intrinsic_sizeof (se, expr); break; case GFC_ISYM_SUM: gfc_conv_intrinsic_arith (se, expr, PLUS_EXPR); break; case GFC_ISYM_TRANSFER: ! if (se->ss) { ! if (se->ss->useflags) ! { ! /* Access the previously obtained result. */ ! gfc_conv_tmp_array_ref (se); ! gfc_advance_se_ss_chain (se); ! break; ! } ! else ! gfc_conv_intrinsic_array_transfer (se, expr); } else gfc_conv_intrinsic_transfer (se, expr); --- 4841,4860 ---- gfc_conv_intrinsic_sizeof (se, expr); break; + case GFC_ISYM_SPACING: + gfc_conv_intrinsic_spacing (se, expr); + break; + case GFC_ISYM_SUM: gfc_conv_intrinsic_arith (se, expr, PLUS_EXPR); break; case GFC_ISYM_TRANSFER: ! if (se->ss && se->ss->useflags) { ! /* Access the previously obtained result. */ ! gfc_conv_tmp_array_ref (se); ! gfc_advance_se_ss_chain (se); } else gfc_conv_intrinsic_transfer (se, expr); *************** gfc_conv_intrinsic_function (gfc_se * se *** 4140,4145 **** --- 4918,4931 ---- gfc_conv_intrinsic_funcall (se, expr); break; + case GFC_ISYM_EOSHIFT: + case GFC_ISYM_PACK: + case GFC_ISYM_RESHAPE: + /* For those, expr->rank should always be >0 and thus the if above the + switch should have matched. */ + gcc_unreachable (); + break; + default: gfc_conv_intrinsic_lib_function (se, expr); break; *************** gfc_walk_intrinsic_libfunc (gfc_ss * ss, *** 4206,4212 **** } ! /* Returns nonzero if the specified intrinsic function call maps directly to a an external library call. Should only be used for functions that return arrays. */ --- 4992,4998 ---- } ! /* Returns nonzero if the specified intrinsic function call maps directly to an external library call. Should only be used for functions that return arrays. */ diff -Nrcpad gcc-4.3.3/gcc/fortran/trans-io.c gcc-4.4.0/gcc/fortran/trans-io.c *** gcc-4.3.3/gcc/fortran/trans-io.c Tue Jan 22 21:22:13 2008 --- gcc-4.4.0/gcc/fortran/trans-io.c Sat Nov 22 08:10:41 2008 *************** *** 1,6 **** /* IO Code translation/library interface ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software ! Foundation, Inc. Contributed by Paul Brook This file is part of GCC. --- 1,6 ---- /* IO Code translation/library interface ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 ! Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. *************** along with GCC; see the file COPYING3. *** 24,30 **** #include "system.h" #include "coretypes.h" #include "tree.h" ! #include "tree-gimple.h" #include "ggc.h" #include "toplev.h" #include "real.h" --- 24,30 ---- #include "system.h" #include "coretypes.h" #include "tree.h" ! #include "gimple.h" #include "ggc.h" #include "toplev.h" #include "real.h" *************** enum ioparam_type *** 45,50 **** --- 45,51 ---- IOPARM_ptype_filepos, IOPARM_ptype_inquire, IOPARM_ptype_dt, + IOPARM_ptype_wait, IOPARM_ptype_num }; *************** static GTY(()) gfc_st_parameter st_param *** 96,102 **** { "close", NULL }, { "filepos", NULL }, { "inquire", NULL }, ! { "dt", NULL } }; static GTY(()) gfc_st_parameter_field st_parameter_field[] = --- 97,104 ---- { "close", NULL }, { "filepos", NULL }, { "inquire", NULL }, ! { "dt", NULL }, ! { "wait", NULL } }; static GTY(()) gfc_st_parameter_field st_parameter_field[] = *************** enum iocall *** 119,124 **** --- 121,127 ---- IOCALL_X_INTEGER, IOCALL_X_LOGICAL, IOCALL_X_CHARACTER, + IOCALL_X_CHARACTER_WIDE, IOCALL_X_REAL, IOCALL_X_COMPLEX, IOCALL_X_ARRAY, *************** enum iocall *** 133,138 **** --- 136,142 ---- IOCALL_FLUSH, IOCALL_SET_NML_VAL, IOCALL_SET_NML_VAL_DIM, + IOCALL_WAIT, IOCALL_NUM }; *************** gfc_trans_io_runtime_check (tree cond, t *** 240,246 **** arg2 = build_int_cst (integer_type_node, error_code), asprintf (&message, "%s", _(msgid)); ! arg3 = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const(message)); gfc_free(message); tmp = build_call_expr (gfor_fndecl_generate_error, 3, arg1, arg2, arg3); --- 244,251 ---- arg2 = build_int_cst (integer_type_node, error_code), asprintf (&message, "%s", _(msgid)); ! arg3 = gfc_build_addr_expr (pchar_type_node, ! gfc_build_localized_cstring_const (message)); gfc_free(message); tmp = build_call_expr (gfor_fndecl_generate_error, 3, arg1, arg2, arg3); *************** gfc_build_io_library_fndecls (void) *** 288,294 **** types[IOPARM_type_pchar] = pchar_type_node; pad_size = 16 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (pchar_type_node)); pad_size += 32 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (integer_type_node)); ! pad_idx = build_index_type (build_int_cst (NULL_TREE, pad_size)); types[IOPARM_type_pad] = build_array_type (char_type_node, pad_idx); /* pad actually contains pointers and integers so it needs to have an --- 293,299 ---- types[IOPARM_type_pchar] = pchar_type_node; pad_size = 16 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (pchar_type_node)); pad_size += 32 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (integer_type_node)); ! pad_idx = build_index_type (build_int_cst (NULL_TREE, pad_size - 1)); types[IOPARM_type_pad] = build_array_type (char_type_node, pad_idx); /* pad actually contains pointers and integers so it needs to have an *************** gfc_build_io_library_fndecls (void) *** 296,302 **** 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_max_integer_kind))); for (ptype = IOPARM_ptype_common; ptype < IOPARM_ptype_num; ptype++) gfc_build_st_parameter (ptype, types); --- 301,307 ---- 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))); for (ptype = IOPARM_ptype_common; ptype < IOPARM_ptype_num; ptype++) gfc_build_st_parameter (ptype, types); *************** gfc_build_io_library_fndecls (void) *** 323,328 **** --- 328,340 ---- void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node); + iocall[IOCALL_X_CHARACTER_WIDE] = + gfc_build_library_function_decl (get_identifier + (PREFIX("transfer_character_wide")), + void_type_node, 4, dt_parm_type, + pvoid_type_node, gfc_charlen_type_node, + gfc_int4_type_node); + iocall[IOCALL_X_REAL] = gfc_build_library_function_decl (get_identifier (PREFIX("transfer_real")), void_type_node, 3, dt_parm_type, *************** gfc_build_io_library_fndecls (void) *** 371,376 **** --- 383,393 ---- gfc_build_library_function_decl(get_identifier (PREFIX("st_iolength")), void_type_node, 1, dt_parm_type); + parm_type = build_pointer_type (st_parameter[IOPARM_ptype_wait].type); + iocall[IOCALL_WAIT] = + gfc_build_library_function_decl (get_identifier (PREFIX("st_wait")), + gfc_int4_type_node, 1, parm_type); + parm_type = build_pointer_type (st_parameter[IOPARM_ptype_filepos].type); iocall[IOCALL_REWIND] = gfc_build_library_function_decl (get_identifier (PREFIX("st_rewind")), *************** set_parameter_const (stmtblock_t *block, *** 429,439 **** gfc_st_parameter_field *p = &st_parameter_field[type]; if (p->param_type == IOPARM_ptype_common) ! var = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, ! var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); ! tmp = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, ! NULL_TREE); ! gfc_add_modify_expr (block, tmp, build_int_cst (TREE_TYPE (p->field), val)); return p->mask; } --- 446,456 ---- gfc_st_parameter_field *p = &st_parameter_field[type]; if (p->param_type == IOPARM_ptype_common) ! var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, ! var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); ! tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, ! NULL_TREE); ! gfc_add_modify (block, tmp, build_int_cst (TREE_TYPE (p->field), val)); return p->mask; } *************** set_parameter_value (stmtblock_t *block, *** 484,494 **** gfc_add_block_to_block (block, &se.pre); if (p->param_type == IOPARM_ptype_common) ! var = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, ! var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); ! tmp = build3 (COMPONENT_REF, dest_type, var, p->field, NULL_TREE); ! gfc_add_modify_expr (block, tmp, se.expr); return p->mask; } --- 501,511 ---- gfc_add_block_to_block (block, &se.pre); if (p->param_type == IOPARM_ptype_common) ! var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, ! var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); ! tmp = fold_build3 (COMPONENT_REF, dest_type, var, p->field, NULL_TREE); ! gfc_add_modify (block, tmp, se.expr); return p->mask; } *************** set_parameter_ref (stmtblock_t *block, s *** 518,524 **** /* If this is for the iostat variable initialize the user variable to LIBERROR_OK which is zero. */ if (type == IOPARM_common_iostat) ! gfc_add_modify_expr (block, se.expr, build_int_cst (TREE_TYPE (se.expr), LIBERROR_OK)); } else --- 535,541 ---- /* If this is for the iostat variable initialize the user variable to LIBERROR_OK which is zero. */ if (type == IOPARM_common_iostat) ! gfc_add_modify (block, se.expr, build_int_cst (TREE_TYPE (se.expr), LIBERROR_OK)); } else *************** set_parameter_ref (stmtblock_t *block, s *** 532,552 **** /* If this is for the iostat variable, initialize the user variable to LIBERROR_OK which is zero. */ if (type == IOPARM_common_iostat) ! gfc_add_modify_expr (block, tmpvar, build_int_cst (TREE_TYPE (tmpvar), LIBERROR_OK)); addr = build_fold_addr_expr (tmpvar); /* After the I/O operation, we set the variable from the temporary. */ tmp = convert (TREE_TYPE (se.expr), tmpvar); ! gfc_add_modify_expr (postblock, se.expr, tmp); } if (p->param_type == IOPARM_ptype_common) ! var = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, ! var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); ! tmp = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, ! NULL_TREE); ! gfc_add_modify_expr (block, tmp, addr); return p->mask; } --- 549,569 ---- /* If this is for the iostat variable, initialize the user variable to LIBERROR_OK which is zero. */ if (type == IOPARM_common_iostat) ! gfc_add_modify (block, tmpvar, build_int_cst (TREE_TYPE (tmpvar), LIBERROR_OK)); addr = build_fold_addr_expr (tmpvar); /* After the I/O operation, we set the variable from the temporary. */ tmp = convert (TREE_TYPE (se.expr), tmpvar); ! gfc_add_modify (postblock, se.expr, tmp); } if (p->param_type == IOPARM_ptype_common) ! var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, ! var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); ! tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), ! var, p->field, NULL_TREE); ! gfc_add_modify (block, tmp, addr); return p->mask; } *************** set_string (stmtblock_t * block, stmtblo *** 631,642 **** gfc_init_se (&se, NULL); if (p->param_type == IOPARM_ptype_common) ! var = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, ! var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); ! io = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, ! NULL_TREE); ! len = build3 (COMPONENT_REF, TREE_TYPE (p->field_len), var, p->field_len, ! NULL_TREE); /* Integer variable assigned a format label. */ if (e->ts.type == BT_INTEGER && e->symtree->n.sym->attr.assign == 1) --- 648,659 ---- gfc_init_se (&se, NULL); if (p->param_type == IOPARM_ptype_common) ! var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, ! var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); ! io = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), ! var, p->field, NULL_TREE); ! len = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field_len), ! var, p->field_len, NULL_TREE); /* Integer variable assigned a format label. */ if (e->ts.type == BT_INTEGER && e->symtree->n.sym->attr.assign == 1) *************** set_string (stmtblock_t * block, stmtblo *** 651,663 **** asprintf(&msg, "Label assigned to variable '%s' (%%ld) is not a format " "label", e->symtree->name); ! gfc_trans_runtime_check (cond, &se.pre, &e->where, msg, fold_convert (long_integer_type_node, tmp)); gfc_free (msg); ! gfc_add_modify_expr (&se.pre, io, fold_convert (TREE_TYPE (io), GFC_DECL_ASSIGN_ADDR (se.expr))); ! gfc_add_modify_expr (&se.pre, len, GFC_DECL_STRING_LEN (se.expr)); } else { --- 668,680 ---- asprintf(&msg, "Label assigned to variable '%s' (%%ld) is not a format " "label", e->symtree->name); ! gfc_trans_runtime_check (true, false, cond, &se.pre, &e->where, msg, fold_convert (long_integer_type_node, tmp)); gfc_free (msg); ! gfc_add_modify (&se.pre, io, fold_convert (TREE_TYPE (io), GFC_DECL_ASSIGN_ADDR (se.expr))); ! gfc_add_modify (&se.pre, len, GFC_DECL_STRING_LEN (se.expr)); } else { *************** set_string (stmtblock_t * block, stmtblo *** 671,678 **** gcc_unreachable (); gfc_conv_string_parameter (&se); ! gfc_add_modify_expr (&se.pre, io, fold_convert (TREE_TYPE (io), se.expr)); ! gfc_add_modify_expr (&se.pre, len, se.string_length); } gfc_add_block_to_block (block, &se.pre); --- 688,695 ---- gcc_unreachable (); gfc_conv_string_parameter (&se); ! gfc_add_modify (&se.pre, io, fold_convert (TREE_TYPE (io), se.expr)); ! gfc_add_modify (&se.pre, len, se.string_length); } gfc_add_block_to_block (block, &se.pre); *************** set_internal_unit (stmtblock_t * block, *** 700,712 **** p = &st_parameter_field[IOPARM_dt_internal_unit]; mask = p->mask; ! io = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, ! NULL_TREE); ! len = build3 (COMPONENT_REF, TREE_TYPE (p->field_len), var, p->field_len, ! NULL_TREE); p = &st_parameter_field[IOPARM_dt_internal_unit_desc]; ! desc = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, ! NULL_TREE); gcc_assert (e->ts.type == BT_CHARACTER); --- 717,729 ---- p = &st_parameter_field[IOPARM_dt_internal_unit]; mask = p->mask; ! io = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), ! var, p->field, NULL_TREE); ! len = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field_len), ! var, p->field_len, NULL_TREE); p = &st_parameter_field[IOPARM_dt_internal_unit_desc]; ! desc = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), ! var, p->field, NULL_TREE); gcc_assert (e->ts.type == BT_CHARACTER); *************** set_internal_unit (stmtblock_t * block, *** 747,756 **** /* The cast is needed for character substrings and the descriptor data. */ ! gfc_add_modify_expr (&se.pre, io, fold_convert (TREE_TYPE (io), tmp)); ! gfc_add_modify_expr (&se.pre, len, fold_convert (TREE_TYPE (len), se.string_length)); ! gfc_add_modify_expr (&se.pre, desc, se.expr); gfc_add_block_to_block (block, &se.pre); gfc_add_block_to_block (post_block, &se.post); --- 764,773 ---- /* The cast is needed for character substrings and the descriptor data. */ ! gfc_add_modify (&se.pre, io, fold_convert (TREE_TYPE (io), tmp)); ! gfc_add_modify (&se.pre, len, fold_convert (TREE_TYPE (len), se.string_length)); ! gfc_add_modify (&se.pre, desc, se.expr); gfc_add_block_to_block (block, &se.pre); gfc_add_block_to_block (post_block, &se.post); *************** io_result (stmtblock_t * block, tree var *** 814,825 **** tmp = gfc_finish_block (&body); ! var = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, ! var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); ! rc = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, ! NULL_TREE); ! rc = build2 (BIT_AND_EXPR, TREE_TYPE (rc), rc, ! build_int_cst (TREE_TYPE (rc), IOPARM_common_libreturn_mask)); tmp = build3_v (SWITCH_EXPR, rc, tmp, NULL_TREE); --- 831,843 ---- tmp = gfc_finish_block (&body); ! var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, ! var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); ! rc = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), ! var, p->field, NULL_TREE); ! rc = fold_build2 (BIT_AND_EXPR, TREE_TYPE (rc), ! rc, build_int_cst (TREE_TYPE (rc), ! IOPARM_common_libreturn_mask)); tmp = build3_v (SWITCH_EXPR, rc, tmp, NULL_TREE); *************** set_error_locus (stmtblock_t * block, tr *** 838,858 **** int line; gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_filename]; ! locus_file = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, ! var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); ! locus_file = build3 (COMPONENT_REF, TREE_TYPE (p->field), locus_file, ! p->field, NULL_TREE); f = where->lb->file; str = gfc_build_cstring_const (f->filename); str = gfc_build_addr_expr (pchar_type_node, str); ! gfc_add_modify_expr (block, locus_file, str); - #ifdef USE_MAPPED_LOCATION line = LOCATION_LINE (where->lb->location); - #else - line = where->lb->linenum; - #endif set_parameter_const (block, var, IOPARM_common_line, line); } --- 856,873 ---- int line; gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_filename]; ! locus_file = fold_build3 (COMPONENT_REF, ! st_parameter[IOPARM_ptype_common].type, ! var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); ! locus_file = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), ! locus_file, p->field, NULL_TREE); f = where->lb->file; str = gfc_build_cstring_const (f->filename); str = gfc_build_addr_expr (pchar_type_node, str); ! gfc_add_modify (block, locus_file, str); line = LOCATION_LINE (where->lb->location); set_parameter_const (block, var, IOPARM_common_line, line); } *************** gfc_trans_open (gfc_code * code) *** 922,927 **** --- 937,960 ---- if (p->pad) mask |= set_string (&block, &post_block, var, IOPARM_open_pad, p->pad); + if (p->decimal) + mask |= set_string (&block, &post_block, var, IOPARM_open_decimal, + p->decimal); + + if (p->encoding) + mask |= set_string (&block, &post_block, var, IOPARM_open_encoding, + p->encoding); + + if (p->round) + mask |= set_string (&block, &post_block, var, IOPARM_open_round, p->round); + + if (p->sign) + mask |= set_string (&block, &post_block, var, IOPARM_open_sign, p->sign); + + if (p->asynchronous) + mask |= set_string (&block, &post_block, var, IOPARM_open_asynchronous, + p->asynchronous); + if (p->convert) mask |= set_string (&block, &post_block, var, IOPARM_open_convert, p->convert); *************** gfc_trans_inquire (gfc_code * code) *** 1118,1124 **** stmtblock_t block, post_block; gfc_inquire *p; tree tmp, var; ! unsigned int mask = 0; gfc_start_block (&block); gfc_init_block (&post_block); --- 1151,1157 ---- stmtblock_t block, post_block; gfc_inquire *p; tree tmp, var; ! unsigned int mask = 0, mask2 = 0; gfc_start_block (&block); gfc_init_block (&post_block); *************** gfc_trans_inquire (gfc_code * code) *** 1213,1218 **** --- 1246,1255 ---- mask |= set_string (&block, &post_block, var, IOPARM_inquire_blank, p->blank); + if (p->delim) + mask |= set_string (&block, &post_block, var, IOPARM_inquire_delim, + p->delim); + if (p->position) mask |= set_string (&block, &post_block, var, IOPARM_inquire_position, p->position); *************** gfc_trans_inquire (gfc_code * code) *** 1233,1246 **** mask |= set_string (&block, &post_block, var, IOPARM_inquire_readwrite, p->readwrite); - if (p->delim) - mask |= set_string (&block, &post_block, var, IOPARM_inquire_delim, - p->delim); - if (p->pad) mask |= set_string (&block, &post_block, var, IOPARM_inquire_pad, p->pad); ! if (p->convert) mask |= set_string (&block, &post_block, var, IOPARM_inquire_convert, p->convert); --- 1270,1279 ---- mask |= set_string (&block, &post_block, var, IOPARM_inquire_readwrite, p->readwrite); if (p->pad) mask |= set_string (&block, &post_block, var, IOPARM_inquire_pad, p->pad); ! if (p->convert) mask |= set_string (&block, &post_block, var, IOPARM_inquire_convert, p->convert); *************** gfc_trans_inquire (gfc_code * code) *** 1249,1254 **** --- 1282,1323 ---- mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_strm_pos_out, p->strm_pos); + /* The second series of flags. */ + if (p->asynchronous) + mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_asynchronous, + p->asynchronous); + + if (p->decimal) + mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_decimal, + p->decimal); + + if (p->encoding) + mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_encoding, + p->encoding); + + if (p->round) + mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_round, + p->round); + + if (p->sign) + mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_sign, + p->sign); + + if (p->pending) + mask2 |= set_parameter_ref (&block, &post_block, var, + IOPARM_inquire_pending, p->pending); + + if (p->size) + mask2 |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_size, + p->size); + + if (p->id) + mask2 |= set_parameter_ref (&block, &post_block,var, IOPARM_inquire_id, + p->id); + + if (mask2) + mask |= set_parameter_const (&block, var, IOPARM_inquire_flags2, mask2); + set_parameter_const (&block, var, IOPARM_common_flags, mask); if (p->unit) *************** gfc_trans_inquire (gfc_code * code) *** 1267,1272 **** --- 1336,1391 ---- return gfc_finish_block (&block); } + + tree + gfc_trans_wait (gfc_code * code) + { + stmtblock_t block, post_block; + gfc_wait *p; + tree tmp, var; + unsigned int mask = 0; + + gfc_start_block (&block); + gfc_init_block (&post_block); + + var = gfc_create_var (st_parameter[IOPARM_ptype_wait].type, + "wait_parm"); + + set_error_locus (&block, var, &code->loc); + p = code->ext.wait; + + /* Set parameters here. */ + if (p->iomsg) + mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg, + p->iomsg); + + if (p->iostat) + mask |= set_parameter_ref (&block, &post_block, var, IOPARM_common_iostat, + p->iostat); + + if (p->err) + mask |= IOPARM_common_err; + + if (p->id) + mask |= set_parameter_value (&block, var, IOPARM_wait_id, p->id); + + set_parameter_const (&block, var, IOPARM_common_flags, mask); + + if (p->unit) + set_parameter_value (&block, var, IOPARM_common_unit, p->unit); + + tmp = build_fold_addr_expr (var); + tmp = build_call_expr (iocall[IOCALL_WAIT], 1, tmp); + gfc_add_expr_to_block (&block, tmp); + + gfc_add_block_to_block (&block, &post_block); + + io_result (&block, var, p->err, NULL, NULL); + + return gfc_finish_block (&block); + + } + static gfc_expr * gfc_new_nml_name_expr (const char * name) { *************** gfc_new_nml_name_expr (const char * name *** 1278,1285 **** nml_name->ts.kind = gfc_default_character_kind; nml_name->ts.type = BT_CHARACTER; nml_name->value.character.length = strlen(name); ! nml_name->value.character.string = gfc_getmem (strlen (name) + 1); ! strcpy (nml_name->value.character.string, name); return nml_name; } --- 1397,1403 ---- nml_name->ts.kind = gfc_default_character_kind; nml_name->ts.type = BT_CHARACTER; nml_name->value.character.length = strlen(name); ! nml_name->value.character.string = gfc_char_to_widechar (name); return nml_name; } *************** nml_get_addr_expr (gfc_symbol * sym, gfc *** 1357,1364 **** the derived type. */ if (TREE_CODE (decl) == FIELD_DECL) ! tmp = build3 (COMPONENT_REF, TREE_TYPE (tmp), ! base_addr, tmp, NULL_TREE); /* If we have a derived type component, a reference to the first element of the array is built. This is done so that base_addr, --- 1475,1482 ---- the derived type. */ if (TREE_CODE (decl) == FIELD_DECL) ! tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (tmp), ! base_addr, tmp, NULL_TREE); /* If we have a derived type component, a reference to the first element of the array is built. This is done so that base_addr, *************** build_dt (tree function, gfc_code * code *** 1584,1589 **** --- 1702,1742 ---- if (dt->end) mask |= IOPARM_common_end; + if (dt->id) + mask |= set_parameter_ref (&block, &post_end_block, var, + IOPARM_dt_id, dt->id); + + if (dt->pos) + mask |= set_parameter_value (&block, var, IOPARM_dt_pos, dt->pos); + + if (dt->asynchronous) + mask |= set_string (&block, &post_block, var, IOPARM_dt_asynchronous, + dt->asynchronous); + + if (dt->blank) + mask |= set_string (&block, &post_block, var, IOPARM_dt_blank, + dt->blank); + + if (dt->decimal) + mask |= set_string (&block, &post_block, var, IOPARM_dt_decimal, + dt->decimal); + + if (dt->delim) + mask |= set_string (&block, &post_block, var, IOPARM_dt_delim, + dt->delim); + + if (dt->pad) + mask |= set_string (&block, &post_block, var, IOPARM_dt_pad, + dt->pad); + + if (dt->round) + mask |= set_string (&block, &post_block, var, IOPARM_dt_round, + dt->round); + + if (dt->sign) + mask |= set_string (&block, &post_block, var, IOPARM_dt_sign, + dt->sign); + if (dt->rec) mask |= set_parameter_value (&block, var, IOPARM_dt_rec, dt->rec); *************** transfer_expr (gfc_se * se, gfc_typespec *** 1745,1751 **** recursive. */ static tree ! transfer_array_component (tree expr, gfc_component * cm) { tree tmp; stmtblock_t body; --- 1898,1904 ---- recursive. */ static tree ! transfer_array_component (tree expr, gfc_component * cm, locus * where) { tree tmp; stmtblock_t body; *************** transfer_array_component (tree expr, gfc *** 1789,1795 **** gfc_init_loopinfo (&loop); gfc_add_ss_to_loop (&loop, ss); gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop); gfc_mark_ss_chain_used (ss, 1); gfc_start_scalarized_body (&loop, &body); --- 1942,1948 ---- gfc_init_loopinfo (&loop); gfc_add_ss_to_loop (&loop, ss); gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop, where); gfc_mark_ss_chain_used (ss, 1); gfc_start_scalarized_body (&loop, &body); *************** transfer_array_component (tree expr, gfc *** 1830,1836 **** static void transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code) { ! tree tmp, function, arg2, field, expr; gfc_component *c; int kind; --- 1983,1989 ---- static void transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code) { ! tree tmp, function, arg2, arg3, field, expr; gfc_component *c; int kind; *************** transfer_expr (gfc_se * se, gfc_typespec *** 1862,1867 **** --- 2015,2021 ---- kind = ts->kind; function = NULL; arg2 = NULL; + arg3 = NULL; switch (ts->type) { *************** transfer_expr (gfc_se * se, gfc_typespec *** 1886,1891 **** --- 2040,2065 ---- break; case BT_CHARACTER: + if (kind == 4) + { + if (se->string_length) + arg2 = se->string_length; + else + { + tmp = build_fold_indirect_ref (addr_expr); + gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE); + arg2 = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (tmp))); + arg2 = fold_convert (gfc_charlen_type_node, arg2); + } + arg3 = build_int_cst (NULL_TREE, kind); + function = iocall[IOCALL_X_CHARACTER_WIDE]; + tmp = build_fold_addr_expr (dt_parm); + tmp = build_call_expr (function, 4, tmp, addr_expr, arg2, arg3); + gfc_add_expr_to_block (&se->pre, tmp); + gfc_add_block_to_block (&se->pre, &se->post); + return; + } + /* Fall through. */ case BT_HOLLERITH: if (se->string_length) arg2 = se->string_length; *************** transfer_expr (gfc_se * se, gfc_typespec *** 1908,1924 **** field = c->backend_decl; gcc_assert (field && TREE_CODE (field) == FIELD_DECL); ! tmp = build3 (COMPONENT_REF, TREE_TYPE (field), expr, field, ! NULL_TREE); ! if (c->dimension) { ! tmp = transfer_array_component (tmp, c); gfc_add_expr_to_block (&se->pre, tmp); } else { ! if (!c->pointer) tmp = build_fold_addr_expr (tmp); transfer_expr (se, &c->ts, tmp, code); } --- 2082,2098 ---- field = c->backend_decl; gcc_assert (field && TREE_CODE (field) == FIELD_DECL); ! tmp = fold_build3 (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 = build_fold_addr_expr (tmp); transfer_expr (se, &c->ts, tmp, code); } *************** gfc_trans_transfer (gfc_code * code) *** 2037,2043 **** /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop); /* The main loop body. */ gfc_mark_ss_chain_used (ss, 1); --- 2211,2217 ---- /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop, &code->expr->where); /* The main loop body. */ gfc_mark_ss_chain_used (ss, 1); diff -Nrcpad gcc-4.3.3/gcc/fortran/trans-openmp.c gcc-4.4.0/gcc/fortran/trans-openmp.c *** gcc-4.3.3/gcc/fortran/trans-openmp.c Wed Nov 28 19:43:03 2007 --- gcc-4.4.0/gcc/fortran/trans-openmp.c Thu Sep 18 12:02:50 2008 *************** *** 1,5 **** /* OpenMP directive translation -- generate GCC trees from gfc_code. ! Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Jakub Jelinek This file is part of GCC. --- 1,5 ---- /* OpenMP directive translation -- generate GCC trees from gfc_code. ! Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Jakub Jelinek This file is part of GCC. *************** along with GCC; see the file COPYING3. *** 23,29 **** #include "system.h" #include "coretypes.h" #include "tree.h" ! #include "tree-gimple.h" #include "ggc.h" #include "toplev.h" #include "real.h" --- 23,29 ---- #include "system.h" #include "coretypes.h" #include "tree.h" ! #include "gimple.h" #include "ggc.h" #include "toplev.h" #include "real.h" *************** gfc_omp_predetermined_sharing (tree decl *** 84,89 **** --- 84,100 ---- if (GFC_DECL_CRAY_POINTEE (decl)) return OMP_CLAUSE_DEFAULT_PRIVATE; + /* Assumed-size arrays are predetermined to inherit sharing + attributes of the associated actual argument, which is shared + for all we care. */ + 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) + return OMP_CLAUSE_DEFAULT_SHARED; + /* COMMON and EQUIVALENCE decls are shared. They are only referenced through DECL_VALUE_EXPR of the variables contained in them. If those are privatized, they will not be *************** gfc_omp_predetermined_sharing (tree decl *** 98,124 **** } /* Return code to initialize DECL with its default constructor, or NULL if there's nothing to do. */ tree ! gfc_omp_clause_default_ctor (tree clause ATTRIBUTE_UNUSED, tree decl) { ! tree type = TREE_TYPE (decl); ! stmtblock_t block; ! if (! GFC_DESCRIPTOR_TYPE_P (type)) return NULL; /* Allocatable arrays in PRIVATE clauses need to be set to ! "not currently allocated" allocation status. */ ! gfc_init_block (&block); ! gfc_conv_descriptor_data_set_tuples (&block, decl, null_pointer_node); return gfc_finish_block (&block); } /* Return true if DECL's DECL_VALUE_EXPR (if any) should be disregarded in OpenMP construct, because it is going to be --- 109,287 ---- } + /* Return true if DECL in private clause needs + OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause. */ + bool + gfc_omp_private_outer_ref (tree decl) + { + tree type = TREE_TYPE (decl); + + if (GFC_DESCRIPTOR_TYPE_P (type) + && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE) + return true; + + return false; + } + /* Return code to initialize DECL with its default constructor, or NULL if there's nothing to do. */ tree ! gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer) { ! tree type = TREE_TYPE (decl), rank, size, esize, ptr, cond, then_b, else_b; ! stmtblock_t block, cond_block; ! if (! GFC_DESCRIPTOR_TYPE_P (type) ! || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) return NULL; + gcc_assert (outer != NULL); + gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_PRIVATE + || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LASTPRIVATE); + /* Allocatable arrays in PRIVATE clauses need to be set to ! "not currently allocated" allocation status if outer ! array is "not currently allocated", otherwise should be allocated. */ ! gfc_start_block (&block); ! gfc_init_block (&cond_block); ! ! gfc_add_modify (&cond_block, decl, outer); ! rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; ! size = gfc_conv_descriptor_ubound (decl, rank); ! size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size, ! gfc_conv_descriptor_lbound (decl, rank)); ! size = fold_build2 (PLUS_EXPR, gfc_array_index_type, size, ! gfc_index_one_node); ! if (GFC_TYPE_ARRAY_RANK (type) > 1) ! size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, ! gfc_conv_descriptor_stride (decl, rank)); ! esize = fold_convert (gfc_array_index_type, ! TYPE_SIZE_UNIT (gfc_get_element_type (type))); ! size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, esize); ! size = gfc_evaluate_now (fold_convert (size_type_node, size), &cond_block); ! ptr = gfc_allocate_array_with_status (&cond_block, ! build_int_cst (pvoid_type_node, 0), ! size, NULL, NULL); ! gfc_conv_descriptor_data_set (&cond_block, decl, ptr); ! then_b = gfc_finish_block (&cond_block); ! ! gfc_init_block (&cond_block); ! gfc_conv_descriptor_data_set (&cond_block, decl, null_pointer_node); ! else_b = gfc_finish_block (&cond_block); ! ! cond = fold_build2 (NE_EXPR, boolean_type_node, ! fold_convert (pvoid_type_node, ! gfc_conv_descriptor_data_get (outer)), ! null_pointer_node); ! gfc_add_expr_to_block (&block, build3 (COND_EXPR, void_type_node, ! cond, then_b, else_b)); return gfc_finish_block (&block); } + /* Build and return code for a copy constructor from SRC to DEST. */ + + tree + gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src) + { + tree type = TREE_TYPE (dest), ptr, size, esize, rank, call; + stmtblock_t block; + + if (! GFC_DESCRIPTOR_TYPE_P (type) + || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) + return build2_v (MODIFY_EXPR, dest, src); + + gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE); + + /* Allocatable arrays in FIRSTPRIVATE clauses need to be allocated + and copied from SRC. */ + gfc_start_block (&block); + + gfc_add_modify (&block, dest, src); + rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; + size = gfc_conv_descriptor_ubound (dest, rank); + size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size, + gfc_conv_descriptor_lbound (dest, rank)); + size = fold_build2 (PLUS_EXPR, gfc_array_index_type, size, + gfc_index_one_node); + if (GFC_TYPE_ARRAY_RANK (type) > 1) + size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, + gfc_conv_descriptor_stride (dest, rank)); + esize = fold_convert (gfc_array_index_type, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); + size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, esize); + size = gfc_evaluate_now (fold_convert (size_type_node, size), &block); + ptr = gfc_allocate_array_with_status (&block, + build_int_cst (pvoid_type_node, 0), + size, NULL, NULL); + gfc_conv_descriptor_data_set (&block, dest, ptr); + call = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3, ptr, + fold_convert (pvoid_type_node, + gfc_conv_descriptor_data_get (src)), + size); + gfc_add_expr_to_block (&block, fold_convert (void_type_node, call)); + + return gfc_finish_block (&block); + } + + /* Similarly, except use an assignment operator instead. */ + + tree + gfc_omp_clause_assign_op (tree clause ATTRIBUTE_UNUSED, tree dest, tree src) + { + tree type = TREE_TYPE (dest), rank, size, esize, call; + stmtblock_t block; + + if (! GFC_DESCRIPTOR_TYPE_P (type) + || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) + return build2_v (MODIFY_EXPR, dest, src); + + /* Handle copying allocatable arrays. */ + gfc_start_block (&block); + + rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; + size = gfc_conv_descriptor_ubound (dest, rank); + size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size, + gfc_conv_descriptor_lbound (dest, rank)); + size = fold_build2 (PLUS_EXPR, gfc_array_index_type, size, + gfc_index_one_node); + if (GFC_TYPE_ARRAY_RANK (type) > 1) + size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, + gfc_conv_descriptor_stride (dest, rank)); + esize = fold_convert (gfc_array_index_type, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); + size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, esize); + size = gfc_evaluate_now (fold_convert (size_type_node, size), &block); + call = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3, + fold_convert (pvoid_type_node, + gfc_conv_descriptor_data_get (dest)), + fold_convert (pvoid_type_node, + gfc_conv_descriptor_data_get (src)), + size); + gfc_add_expr_to_block (&block, fold_convert (void_type_node, call)); + + return gfc_finish_block (&block); + } + + /* Build and return code destructing DECL. Return NULL if nothing + to be done. */ + + tree + gfc_omp_clause_dtor (tree clause ATTRIBUTE_UNUSED, tree decl) + { + tree type = TREE_TYPE (decl); + + if (! GFC_DESCRIPTOR_TYPE_P (type) + || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) + return NULL; + + /* Allocatable arrays in FIRSTPRIVATE/LASTPRIVATE etc. clauses need + to be deallocated if they were allocated. */ + return gfc_trans_dealloc_allocated (decl); + } + /* Return true if DECL's DECL_VALUE_EXPR (if any) should be disregarded in OpenMP construct, because it is going to be *************** gfc_trans_omp_array_reduction (tree c, g *** 291,297 **** tree decl, backend_decl, stmt; locus old_loc = gfc_current_locus; const char *iname; ! try t; decl = OMP_CLAUSE_DECL (c); gfc_current_locus = where; --- 454,460 ---- tree decl, backend_decl, stmt; locus old_loc = gfc_current_locus; const char *iname; ! gfc_try t; decl = OMP_CLAUSE_DECL (c); gfc_current_locus = where; *************** gfc_trans_omp_array_reduction (tree c, g *** 335,340 **** --- 498,504 ---- e1->symtree = symtree1; e1->ts = sym->ts; e1->ref = ref = gfc_get_ref (); + ref->type = REF_ARRAY; ref->u.ar.where = where; ref->u.ar.as = sym->as; ref->u.ar.type = AR_FULL; *************** gfc_trans_omp_array_reduction (tree c, g *** 429,435 **** /* Create the init statement list. */ pushlevel (0); ! stmt = gfc_trans_assignment (e1, e2, false); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0)); else --- 593,631 ---- /* Create the init statement list. */ pushlevel (0); ! if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)) ! && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_ALLOCATABLE) ! { ! /* If decl is an allocatable array, it needs to be allocated ! with the same bounds as the outer var. */ ! tree type = TREE_TYPE (decl), rank, size, esize, ptr; ! stmtblock_t block; ! ! gfc_start_block (&block); ! ! gfc_add_modify (&block, decl, outer_sym.backend_decl); ! rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; ! size = gfc_conv_descriptor_ubound (decl, rank); ! size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size, ! gfc_conv_descriptor_lbound (decl, rank)); ! size = fold_build2 (PLUS_EXPR, gfc_array_index_type, size, ! gfc_index_one_node); ! if (GFC_TYPE_ARRAY_RANK (type) > 1) ! size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, ! gfc_conv_descriptor_stride (decl, rank)); ! esize = fold_convert (gfc_array_index_type, ! TYPE_SIZE_UNIT (gfc_get_element_type (type))); ! size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, esize); ! size = gfc_evaluate_now (fold_convert (size_type_node, size), &block); ! ptr = gfc_allocate_array_with_status (&block, ! build_int_cst (pvoid_type_node, 0), ! size, NULL, NULL); ! gfc_conv_descriptor_data_set (&block, decl, ptr); ! gfc_add_expr_to_block (&block, gfc_trans_assignment (e1, e2, false)); ! stmt = gfc_finish_block (&block); ! } ! else ! stmt = gfc_trans_assignment (e1, e2, false); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0)); else *************** gfc_trans_omp_array_reduction (tree c, g *** 438,444 **** /* Create the merge statement list. */ pushlevel (0); ! stmt = gfc_trans_assignment (e3, e4, false); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0)); else --- 634,653 ---- /* Create the merge statement list. */ pushlevel (0); ! if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)) ! && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_ALLOCATABLE) ! { ! /* If decl is an allocatable array, it needs to be deallocated ! afterwards. */ ! stmtblock_t block; ! ! gfc_start_block (&block); ! gfc_add_expr_to_block (&block, gfc_trans_assignment (e3, e4, false)); ! gfc_add_expr_to_block (&block, gfc_trans_dealloc_allocated (decl)); ! stmt = gfc_finish_block (&block); ! } ! else ! stmt = gfc_trans_assignment (e3, e4, false); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0)); else *************** gfc_trans_omp_clauses (stmtblock_t *bloc *** 639,644 **** --- 848,856 ---- case OMP_SCHED_RUNTIME: OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_RUNTIME; break; + case OMP_SCHED_AUTO: + OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_AUTO; + break; default: gcc_unreachable (); } *************** gfc_trans_omp_clauses (stmtblock_t *bloc *** 659,664 **** --- 871,879 ---- case OMP_DEFAULT_PRIVATE: OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_PRIVATE; break; + case OMP_DEFAULT_FIRSTPRIVATE: + OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_FIRSTPRIVATE; + break; default: gcc_unreachable (); } *************** gfc_trans_omp_clauses (stmtblock_t *bloc *** 677,682 **** --- 892,910 ---- omp_clauses = gfc_trans_add_clause (c, omp_clauses); } + if (clauses->untied) + { + c = build_omp_clause (OMP_CLAUSE_UNTIED); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->collapse) + { + c = build_omp_clause (OMP_CLAUSE_COLLAPSE); + OMP_CLAUSE_COLLAPSE_EXPR (c) = build_int_cst (NULL, clauses->collapse); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + return omp_clauses; } *************** gfc_trans_omp_atomic (gfc_code *code) *** 742,748 **** if (expr2->expr_type == EXPR_OP) { gfc_expr *e; ! switch (expr2->value.op.operator) { case INTRINSIC_PLUS: op = PLUS_EXPR; --- 970,976 ---- if (expr2->expr_type == EXPR_OP) { gfc_expr *e; ! switch (expr2->value.op.op) { case INTRINSIC_PLUS: op = PLUS_EXPR; *************** gfc_trans_omp_atomic (gfc_code *code) *** 835,841 **** tree accum = gfc_create_var (TREE_TYPE (rse.expr), NULL); gfc_actual_arglist *arg; ! gfc_add_modify_stmt (&block, accum, rse.expr); for (arg = expr2->value.function.actual->next->next; arg; arg = arg->next) { --- 1063,1069 ---- tree accum = gfc_create_var (TREE_TYPE (rse.expr), NULL); gfc_actual_arglist *arg; ! gfc_add_modify (&block, accum, rse.expr); for (arg = expr2->value.function.actual->next->next; arg; arg = arg->next) { *************** gfc_trans_omp_atomic (gfc_code *code) *** 843,849 **** gfc_conv_expr (&rse, arg->expr); gfc_add_block_to_block (&block, &rse.pre); x = fold_build2 (op, TREE_TYPE (accum), accum, rse.expr); ! gfc_add_modify_stmt (&block, accum, x); } rse.expr = accum; --- 1071,1077 ---- gfc_conv_expr (&rse, arg->expr); gfc_add_block_to_block (&block, &rse.pre); x = fold_build2 (op, TREE_TYPE (accum), accum, rse.expr); ! gfc_add_modify (&block, accum, x); } rse.expr = accum; *************** gfc_trans_omp_atomic (gfc_code *code) *** 863,869 **** if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE && TREE_CODE (type) != COMPLEX_TYPE) ! x = build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (rhs)), x); x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x)); gfc_add_expr_to_block (&block, x); --- 1091,1097 ---- if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE && TREE_CODE (type) != COMPLEX_TYPE) ! x = fold_build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (rhs)), x); x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x)); gfc_add_expr_to_block (&block, x); *************** gfc_trans_omp_critical (gfc_code *code) *** 888,912 **** if (code->ext.omp_name != NULL) name = get_identifier (code->ext.omp_name); stmt = gfc_trans_code (code->block->next); ! return build2_v (OMP_CRITICAL, stmt, name); } static tree gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, ! gfc_omp_clauses *do_clauses) { gfc_se se; tree dovar, stmt, from, to, step, type, init, cond, incr; tree count = NULL_TREE, cycle_label, tmp, omp_clauses; stmtblock_t block; stmtblock_t body; - int simple = 0; - bool dovar_found = false; gfc_omp_clauses *clauses = code->ext.omp_clauses; ! code = code->block->next; gcc_assert (code->op == EXEC_DO); if (pblock == NULL) { gfc_start_block (&block); --- 1116,1148 ---- if (code->ext.omp_name != NULL) name = get_identifier (code->ext.omp_name); stmt = gfc_trans_code (code->block->next); ! return build2 (OMP_CRITICAL, void_type_node, stmt, name); } static tree gfc_trans_omp_do (gfc_code *code, 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 count = NULL_TREE, cycle_label, tmp, omp_clauses; stmtblock_t block; stmtblock_t body; gfc_omp_clauses *clauses = code->ext.omp_clauses; + gfc_code *outermost; + int i, collapse = clauses->collapse; + tree dovar_init = NULL_TREE; ! if (collapse <= 0) ! collapse = 1; ! ! outermost = code = code->block->next; gcc_assert (code->op == EXEC_DO); + init = make_tree_vec (collapse); + cond = make_tree_vec (collapse); + incr = make_tree_vec (collapse); + if (pblock == NULL) { gfc_start_block (&block); *************** gfc_trans_omp_do (gfc_code *code, stmtbl *** 914,1020 **** } omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc); ! if (clauses) { ! gfc_namelist *n; ! for (n = clauses->lists[OMP_LIST_LASTPRIVATE]; n != NULL; n = n->next) ! if (code->ext.iterator->var->symtree->n.sym == n->sym) ! break; ! if (n == NULL) ! for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next) ! if (code->ext.iterator->var->symtree->n.sym == n->sym) ! break; ! if (n != NULL) ! dovar_found = true; ! } ! /* Evaluate all the expressions in the iterator. */ ! gfc_init_se (&se, NULL); ! gfc_conv_expr_lhs (&se, code->ext.iterator->var); ! gfc_add_block_to_block (pblock, &se.pre); ! dovar = se.expr; ! type = TREE_TYPE (dovar); ! gcc_assert (TREE_CODE (type) == INTEGER_TYPE); ! gfc_init_se (&se, NULL); ! gfc_conv_expr_val (&se, code->ext.iterator->start); ! gfc_add_block_to_block (pblock, &se.pre); ! from = gfc_evaluate_now (se.expr, pblock); ! gfc_init_se (&se, NULL); ! gfc_conv_expr_val (&se, code->ext.iterator->end); ! gfc_add_block_to_block (pblock, &se.pre); ! to = gfc_evaluate_now (se.expr, pblock); ! gfc_init_se (&se, NULL); ! gfc_conv_expr_val (&se, code->ext.iterator->step); ! gfc_add_block_to_block (pblock, &se.pre); ! step = gfc_evaluate_now (se.expr, pblock); ! /* Special case simple loops. */ ! if (integer_onep (step)) ! simple = 1; ! else if (tree_int_cst_equal (step, integer_minus_one_node)) ! simple = -1; ! /* Loop body. */ ! if (simple) ! { ! init = build2_v (GIMPLE_MODIFY_STMT, dovar, from); ! cond = build2 (simple > 0 ? LE_EXPR : GE_EXPR, boolean_type_node, ! dovar, to); ! incr = fold_build2 (PLUS_EXPR, type, dovar, step); ! incr = fold_build2 (GIMPLE_MODIFY_STMT, type, dovar, incr); ! if (pblock != &block) { ! pushlevel (0); ! gfc_start_block (&block); } ! gfc_start_block (&body); ! } ! else ! { ! /* STEP is not 1 or -1. Use: ! for (count = 0; count < (to + step - from) / step; count++) ! { ! dovar = from + count * step; ! body; ! cycle_label:; ! } */ ! tmp = fold_build2 (MINUS_EXPR, type, step, from); ! tmp = fold_build2 (PLUS_EXPR, type, to, tmp); ! tmp = fold_build2 (TRUNC_DIV_EXPR, type, tmp, step); ! tmp = gfc_evaluate_now (tmp, pblock); ! count = gfc_create_var (type, "count"); ! init = build2_v (GIMPLE_MODIFY_STMT, count, build_int_cst (type, 0)); ! cond = build2 (LT_EXPR, boolean_type_node, count, tmp); ! incr = fold_build2 (PLUS_EXPR, type, count, build_int_cst (type, 1)); ! incr = fold_build2 (GIMPLE_MODIFY_STMT, type, count, incr); ! if (pblock != &block) { ! pushlevel (0); ! gfc_start_block (&block); } ! gfc_start_block (&body); ! /* Initialize DOVAR. */ ! tmp = fold_build2 (MULT_EXPR, type, count, step); ! tmp = build2 (PLUS_EXPR, type, from, tmp); ! gfc_add_modify_stmt (&body, dovar, tmp); } ! if (!dovar_found) { ! tmp = build_omp_clause (OMP_CLAUSE_PRIVATE); ! OMP_CLAUSE_DECL (tmp) = dovar; ! omp_clauses = gfc_trans_add_clause (tmp, omp_clauses); } ! if (!simple) { ! tmp = build_omp_clause (OMP_CLAUSE_PRIVATE); ! OMP_CLAUSE_DECL (tmp) = count; ! omp_clauses = gfc_trans_add_clause (tmp, omp_clauses); } /* Cycle statement is implemented with a goto. Exit statement must not be --- 1150,1317 ---- } omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc); ! ! for (i = 0; i < collapse; i++) { ! int simple = 0; ! int dovar_found = 0; ! if (clauses) ! { ! gfc_namelist *n; ! for (n = clauses->lists[OMP_LIST_LASTPRIVATE]; n != NULL; ! n = n->next) ! if (code->ext.iterator->var->symtree->n.sym == n->sym) ! break; ! if (n != NULL) ! dovar_found = 1; ! else if (n == NULL) ! for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next) ! if (code->ext.iterator->var->symtree->n.sym == n->sym) ! break; ! if (n != NULL) ! dovar_found++; ! } ! /* Evaluate all the expressions in the iterator. */ ! gfc_init_se (&se, NULL); ! gfc_conv_expr_lhs (&se, code->ext.iterator->var); ! gfc_add_block_to_block (pblock, &se.pre); ! dovar = se.expr; ! type = TREE_TYPE (dovar); ! gcc_assert (TREE_CODE (type) == INTEGER_TYPE); ! gfc_init_se (&se, NULL); ! gfc_conv_expr_val (&se, code->ext.iterator->start); ! gfc_add_block_to_block (pblock, &se.pre); ! from = gfc_evaluate_now (se.expr, pblock); ! gfc_init_se (&se, NULL); ! gfc_conv_expr_val (&se, code->ext.iterator->end); ! gfc_add_block_to_block (pblock, &se.pre); ! to = gfc_evaluate_now (se.expr, pblock); ! gfc_init_se (&se, NULL); ! gfc_conv_expr_val (&se, code->ext.iterator->step); ! gfc_add_block_to_block (pblock, &se.pre); ! step = gfc_evaluate_now (se.expr, pblock); ! /* Special case simple loops. */ ! if (integer_onep (step)) ! simple = 1; ! else if (tree_int_cst_equal (step, integer_minus_one_node)) ! simple = -1; ! ! /* Loop body. */ ! if (simple) { ! TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, dovar, from); ! TREE_VEC_ELT (cond, i) = fold_build2 (simple > 0 ? LE_EXPR : GE_EXPR, ! boolean_type_node, dovar, to); ! TREE_VEC_ELT (incr, i) = fold_build2 (PLUS_EXPR, type, dovar, step); ! TREE_VEC_ELT (incr, i) = fold_build2 (MODIFY_EXPR, type, dovar, ! TREE_VEC_ELT (incr, i)); } ! else ! { ! /* STEP is not 1 or -1. Use: ! for (count = 0; count < (to + step - from) / step; count++) ! { ! dovar = from + count * step; ! body; ! cycle_label:; ! } */ ! tmp = fold_build2 (MINUS_EXPR, type, step, from); ! tmp = fold_build2 (PLUS_EXPR, type, to, tmp); ! tmp = fold_build2 (TRUNC_DIV_EXPR, type, tmp, step); ! tmp = gfc_evaluate_now (tmp, pblock); ! count = gfc_create_var (type, "count"); ! TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, count, ! build_int_cst (type, 0)); ! TREE_VEC_ELT (cond, i) = fold_build2 (LT_EXPR, boolean_type_node, ! count, tmp); ! TREE_VEC_ELT (incr, i) = fold_build2 (PLUS_EXPR, type, count, ! build_int_cst (type, 1)); ! TREE_VEC_ELT (incr, i) = fold_build2 (MODIFY_EXPR, type, ! count, TREE_VEC_ELT (incr, i)); ! /* Initialize DOVAR. */ ! tmp = fold_build2 (MULT_EXPR, type, count, step); ! tmp = fold_build2 (PLUS_EXPR, type, from, tmp); ! dovar_init = tree_cons (dovar, tmp, dovar_init); ! } ! ! if (!dovar_found) { ! tmp = build_omp_clause (OMP_CLAUSE_PRIVATE); ! OMP_CLAUSE_DECL (tmp) = dovar; ! omp_clauses = gfc_trans_add_clause (tmp, omp_clauses); } ! else if (dovar_found == 2) ! { ! tree c = NULL; ! tmp = NULL; ! if (!simple) ! { ! /* If dovar is lastprivate, but different counter is used, ! dovar += step needs to be added to ! 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 (PLUS_EXPR, type, dovar, tmp); ! tmp = fold_build2 (MODIFY_EXPR, type, dovar, tmp); ! for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c)) ! if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE ! && OMP_CLAUSE_DECL (c) == dovar) ! { ! OMP_CLAUSE_LASTPRIVATE_STMT (c) = tmp; ! break; ! } ! } ! if (c == NULL && par_clauses != NULL) ! { ! for (c = par_clauses; c ; c = OMP_CLAUSE_CHAIN (c)) ! if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE ! && OMP_CLAUSE_DECL (c) == dovar) ! { ! tree l = build_omp_clause (OMP_CLAUSE_LASTPRIVATE); ! OMP_CLAUSE_DECL (l) = dovar; ! OMP_CLAUSE_CHAIN (l) = omp_clauses; ! OMP_CLAUSE_LASTPRIVATE_STMT (l) = tmp; ! omp_clauses = l; ! OMP_CLAUSE_SET_CODE (c, OMP_CLAUSE_SHARED); ! break; ! } ! } ! gcc_assert (simple || c != NULL); ! } ! if (!simple) ! { ! tmp = build_omp_clause (OMP_CLAUSE_PRIVATE); ! OMP_CLAUSE_DECL (tmp) = count; ! omp_clauses = gfc_trans_add_clause (tmp, omp_clauses); ! } ! ! if (i + 1 < collapse) ! code = code->block->next; } ! if (pblock != &block) { ! pushlevel (0); ! gfc_start_block (&block); } ! ! gfc_start_block (&body); ! ! dovar_init = nreverse (dovar_init); ! while (dovar_init) { ! gfc_add_modify (&body, TREE_PURPOSE (dovar_init), ! TREE_VALUE (dovar_init)); ! dovar_init = TREE_CHAIN (dovar_init); } /* Cycle statement is implemented with a goto. Exit statement must not be *************** gfc_trans_omp_parallel (gfc_code *code) *** 1085,1091 **** omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, code->loc); stmt = gfc_trans_omp_code (code->block->next, true); ! stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL); gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); } --- 1382,1388 ---- omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, code->loc); stmt = gfc_trans_omp_code (code->block->next, true); ! stmt = build2 (OMP_PARALLEL, void_type_node, stmt, omp_clauses); gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); } *************** gfc_trans_omp_parallel_do (gfc_code *cod *** 1107,1115 **** --- 1404,1414 ---- do_clauses.sched_kind = parallel_clauses.sched_kind; do_clauses.chunk_size = parallel_clauses.chunk_size; do_clauses.ordered = parallel_clauses.ordered; + do_clauses.collapse = parallel_clauses.collapse; parallel_clauses.sched_kind = OMP_SCHED_NONE; parallel_clauses.chunk_size = NULL; parallel_clauses.ordered = false; + parallel_clauses.collapse = 0; omp_clauses = gfc_trans_omp_clauses (&block, ¶llel_clauses, code->loc); } *************** gfc_trans_omp_parallel_do (gfc_code *cod *** 1118,1129 **** pblock = █ else pushlevel (0); ! stmt = gfc_trans_omp_do (code, pblock, &do_clauses); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0)); else poplevel (0, 0, 0); ! stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL); OMP_PARALLEL_COMBINED (stmt) = 1; gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); --- 1417,1428 ---- pblock = █ else pushlevel (0); ! stmt = gfc_trans_omp_do (code, pblock, &do_clauses, omp_clauses); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0)); else poplevel (0, 0, 0); ! stmt = build2 (OMP_PARALLEL, void_type_node, stmt, omp_clauses); OMP_PARALLEL_COMBINED (stmt) = 1; gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); *************** gfc_trans_omp_parallel_sections (gfc_cod *** 1148,1154 **** stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0)); else poplevel (0, 0, 0); ! stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL); OMP_PARALLEL_COMBINED (stmt) = 1; gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); --- 1447,1453 ---- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0)); else poplevel (0, 0, 0); ! stmt = build2 (OMP_PARALLEL, void_type_node, stmt, omp_clauses); OMP_PARALLEL_COMBINED (stmt) = 1; gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); *************** gfc_trans_omp_parallel_workshare (gfc_co *** 1173,1179 **** stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0)); else poplevel (0, 0, 0); ! stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL); OMP_PARALLEL_COMBINED (stmt) = 1; gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); --- 1472,1478 ---- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0)); else poplevel (0, 0, 0); ! stmt = build2 (OMP_PARALLEL, void_type_node, stmt, omp_clauses); OMP_PARALLEL_COMBINED (stmt) = 1; gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); *************** gfc_trans_omp_sections (gfc_code *code, *** 1205,1211 **** } stmt = gfc_finish_block (&body); ! stmt = build3_v (OMP_SECTIONS, stmt, omp_clauses, NULL_TREE); gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); --- 1504,1510 ---- } stmt = gfc_finish_block (&body); ! stmt = build2 (OMP_SECTIONS, void_type_node, stmt, omp_clauses); gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); *************** gfc_trans_omp_single (gfc_code *code, gf *** 1216,1226 **** { tree omp_clauses = gfc_trans_omp_clauses (NULL, clauses, code->loc); tree stmt = gfc_trans_omp_code (code->block->next, true); ! stmt = build2_v (OMP_SINGLE, stmt, omp_clauses); return stmt; } static tree gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses) { /* XXX */ --- 1515,1547 ---- { tree omp_clauses = gfc_trans_omp_clauses (NULL, clauses, code->loc); tree stmt = gfc_trans_omp_code (code->block->next, true); ! stmt = build2 (OMP_SINGLE, void_type_node, stmt, omp_clauses); return stmt; } static tree + gfc_trans_omp_task (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 = gfc_trans_omp_code (code->block->next, true); + stmt = build2 (OMP_TASK, void_type_node, stmt, omp_clauses); + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); + } + + static tree + gfc_trans_omp_taskwait (void) + { + tree decl = built_in_decls [BUILT_IN_GOMP_TASKWAIT]; + return build_call_expr (decl, 0); + } + + static tree gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses) { /* XXX */ *************** gfc_trans_omp_directive (gfc_code *code) *** 1239,1245 **** case EXEC_OMP_CRITICAL: return gfc_trans_omp_critical (code); case EXEC_OMP_DO: ! return gfc_trans_omp_do (code, NULL, code->ext.omp_clauses); case EXEC_OMP_FLUSH: return gfc_trans_omp_flush (); case EXEC_OMP_MASTER: --- 1560,1566 ---- case EXEC_OMP_CRITICAL: return gfc_trans_omp_critical (code); case EXEC_OMP_DO: ! return gfc_trans_omp_do (code, NULL, code->ext.omp_clauses, NULL); case EXEC_OMP_FLUSH: return gfc_trans_omp_flush (); case EXEC_OMP_MASTER: *************** gfc_trans_omp_directive (gfc_code *code) *** 1258,1263 **** --- 1579,1588 ---- return gfc_trans_omp_sections (code, code->ext.omp_clauses); case EXEC_OMP_SINGLE: return gfc_trans_omp_single (code, code->ext.omp_clauses); + case EXEC_OMP_TASK: + return gfc_trans_omp_task (code); + case EXEC_OMP_TASKWAIT: + return gfc_trans_omp_taskwait (); case EXEC_OMP_WORKSHARE: return gfc_trans_omp_workshare (code, code->ext.omp_clauses); default: diff -Nrcpad gcc-4.3.3/gcc/fortran/trans-stmt.c gcc-4.4.0/gcc/fortran/trans-stmt.c *** gcc-4.3.3/gcc/fortran/trans-stmt.c Wed Jan 14 20:53:18 2009 --- gcc-4.4.0/gcc/fortran/trans-stmt.c Tue Jan 27 18:07:54 2009 *************** *** 1,5 **** /* Statement translation -- generate GCC trees from gfc_code. ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook and Steven Bosscher --- 1,5 ---- /* Statement translation -- generate GCC trees from gfc_code. ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Paul Brook and Steven Bosscher *************** along with GCC; see the file COPYING3. *** 25,31 **** #include "system.h" #include "coretypes.h" #include "tree.h" ! #include "tree-gimple.h" #include "ggc.h" #include "toplev.h" #include "real.h" --- 25,31 ---- #include "system.h" #include "coretypes.h" #include "tree.h" ! #include "gimple.h" #include "ggc.h" #include "toplev.h" #include "real.h" *************** gfc_trans_label_assign (gfc_code * code) *** 99,105 **** tree len; tree addr; tree len_tree; - char *label_str; int label_len; /* Start a new block. */ --- 99,104 ---- *************** gfc_trans_label_assign (gfc_code * code) *** 119,133 **** } else { ! label_str = code->label->format->value.character.string; ! label_len = code->label->format->value.character.length; len_tree = build_int_cst (NULL_TREE, label_len); ! label_tree = gfc_build_string_const (label_len + 1, label_str); label_tree = gfc_build_addr_expr (pvoid_type_node, label_tree); } ! gfc_add_modify_expr (&se.pre, len, len_tree); ! gfc_add_modify_expr (&se.pre, addr, label_tree); return gfc_finish_block (&se.pre); } --- 118,134 ---- } else { ! gfc_expr *format = code->label->format; ! ! label_len = format->value.character.length; len_tree = build_int_cst (NULL_TREE, label_len); ! label_tree = gfc_build_wide_string_const (format->ts.kind, label_len + 1, ! format->value.character.string); label_tree = gfc_build_addr_expr (pvoid_type_node, label_tree); } ! gfc_add_modify (&se.pre, len, len_tree); ! gfc_add_modify (&se.pre, addr, label_tree); return gfc_finish_block (&se.pre); } *************** gfc_trans_goto (gfc_code * code) *** 153,159 **** tmp = GFC_DECL_STRING_LEN (se.expr); tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp, build_int_cst (TREE_TYPE (tmp), -1)); ! gfc_trans_runtime_check (tmp, &se.pre, &loc, "Assigned label is not a target label"); assigned_goto = GFC_DECL_ASSIGN_ADDR (se.expr); --- 154,160 ---- tmp = GFC_DECL_STRING_LEN (se.expr); tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp, build_int_cst (TREE_TYPE (tmp), -1)); ! gfc_trans_runtime_check (true, false, tmp, &se.pre, &loc, "Assigned label is not a target label"); assigned_goto = GFC_DECL_ASSIGN_ADDR (se.expr); *************** gfc_trans_goto (gfc_code * code) *** 161,167 **** code = code->block; if (code == NULL) { ! target = build1 (GOTO_EXPR, void_type_node, assigned_goto); gfc_add_expr_to_block (&se.pre, target); return gfc_finish_block (&se.pre); } --- 162,168 ---- code = code->block; if (code == NULL) { ! target = fold_build1 (GOTO_EXPR, void_type_node, assigned_goto); gfc_add_expr_to_block (&se.pre, target); return gfc_finish_block (&se.pre); } *************** gfc_trans_goto (gfc_code * code) *** 171,185 **** { target = gfc_get_label_decl (code->label); tmp = gfc_build_addr_expr (pvoid_type_node, target); ! tmp = build2 (EQ_EXPR, boolean_type_node, tmp, assigned_goto); tmp = build3_v (COND_EXPR, tmp, ! build1 (GOTO_EXPR, void_type_node, target), build_empty_stmt ()); gfc_add_expr_to_block (&se.pre, tmp); code = code->block; } while (code != NULL); ! gfc_trans_runtime_check (boolean_true_node, &se.pre, &loc, "Assigned label is not in the list"); return gfc_finish_block (&se.pre); --- 172,186 ---- { target = gfc_get_label_decl (code->label); tmp = gfc_build_addr_expr (pvoid_type_node, target); ! tmp = fold_build2 (EQ_EXPR, boolean_type_node, tmp, assigned_goto); tmp = build3_v (COND_EXPR, tmp, ! fold_build1 (GOTO_EXPR, void_type_node, target), build_empty_stmt ()); gfc_add_expr_to_block (&se.pre, tmp); code = code->block; } while (code != NULL); ! gfc_trans_runtime_check (true, false, boolean_true_node, &se.pre, &loc, "Assigned label is not in the list"); return gfc_finish_block (&se.pre); *************** gfc_conv_elemental_dependencies (gfc_se *** 212,218 **** gfc_ss_info *info; gfc_symbol *fsym; int n; - stmtblock_t block; tree data; tree offset; tree size; --- 213,218 ---- *************** gfc_conv_elemental_dependencies (gfc_se *** 251,256 **** --- 251,259 ---- && gfc_check_fncall_dependency (e, fsym->attr.intent, sym, arg0, check_variable)) { + tree initial, temptype; + stmtblock_t temp_post; + /* Make a local loopinfo for the temporary creation, so that none of the other ss->info's have to be renormalized. */ gfc_init_loopinfo (&tmp_loop); *************** gfc_conv_elemental_dependencies (gfc_se *** 261,286 **** tmp_loop.order[n] = loopse->loop->order[n]; } - /* Generate the temporary. Merge the block so that the - declarations are put at the right binding level. */ - size = gfc_create_var (gfc_array_index_type, NULL); - data = gfc_create_var (pvoid_type_node, NULL); - gfc_start_block (&block); - tmp = gfc_typenode_for_spec (&e->ts); - tmp = gfc_trans_create_temp_array (&se->pre, &se->post, - &tmp_loop, info, tmp, - false, true, false); - gfc_add_modify_expr (&se->pre, size, tmp); - tmp = fold_convert (pvoid_type_node, info->data); - gfc_add_modify_expr (&se->pre, data, tmp); - gfc_merge_block_scope (&block); - /* Obtain the argument descriptor for unpacking. */ gfc_init_se (&parmse, NULL); parmse.want_pointer = 1; gfc_conv_expr_descriptor (&parmse, e, gfc_walk_expr (e)); gfc_add_block_to_block (&se->pre, &parmse.pre); /* Calculate the offset for the temporary. */ offset = gfc_index_zero_node; for (n = 0; n < info->dimen; n++) --- 264,308 ---- tmp_loop.order[n] = loopse->loop->order[n]; } /* Obtain the argument descriptor for unpacking. */ gfc_init_se (&parmse, NULL); parmse.want_pointer = 1; gfc_conv_expr_descriptor (&parmse, e, gfc_walk_expr (e)); gfc_add_block_to_block (&se->pre, &parmse.pre); + /* If we've got INTENT(INOUT), initialize the array temporary with + a copy of the values. */ + if (fsym->attr.intent == INTENT_INOUT) + initial = parmse.expr; + else + initial = NULL_TREE; + + /* Find the type of the temporary to create; we don't use the type + of e itself as this breaks for subcomponent-references in e (where + the type of e is that of the final reference, but parmse.expr's + type corresponds to the full derived-type). */ + /* TODO: Fix this somehow so we don't need a temporary of the whole + array but instead only the components referenced. */ + temptype = TREE_TYPE (parmse.expr); /* Pointer to descriptor. */ + gcc_assert (TREE_CODE (temptype) == POINTER_TYPE); + temptype = TREE_TYPE (temptype); + temptype = gfc_get_element_type (temptype); + + /* Generate the temporary. Cleaning up the temporary should be the + very last thing done, so we add the code to a new block and add it + to se->post as last instructions. */ + size = gfc_create_var (gfc_array_index_type, NULL); + data = gfc_create_var (pvoid_type_node, NULL); + gfc_init_block (&temp_post); + tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, + &tmp_loop, info, temptype, + initial, + false, true, false, + &arg->expr->where); + gfc_add_modify (&se->pre, size, tmp); + tmp = fold_convert (pvoid_type_node, info->data); + gfc_add_modify (&se->pre, data, tmp); + /* Calculate the offset for the temporary. */ offset = gfc_index_zero_node; for (n = 0; n < info->dimen; n++) *************** gfc_conv_elemental_dependencies (gfc_se *** 293,305 **** offset, tmp); } info->offset = gfc_create_var (gfc_array_index_type, NULL); ! gfc_add_modify_expr (&se->pre, info->offset, offset); /* Copy the result back using unpack. */ tmp = build_call_expr (gfor_fndecl_in_unpack, 2, parmse.expr, data); gfc_add_expr_to_block (&se->post, tmp); gfc_add_block_to_block (&se->post, &parmse.post); } } } --- 315,329 ---- offset, tmp); } info->offset = gfc_create_var (gfc_array_index_type, NULL); ! gfc_add_modify (&se->pre, info->offset, offset); /* Copy the result back using unpack. */ tmp = build_call_expr (gfor_fndecl_in_unpack, 2, parmse.expr, data); gfc_add_expr_to_block (&se->post, tmp); + /* parmse.pre is already added above. */ gfc_add_block_to_block (&se->post, &parmse.post); + gfc_add_block_to_block (&se->post, &temp_post); } } } *************** gfc_trans_call (gfc_code * code, bool de *** 349,355 **** se.expr = convert (gfc_typenode_for_spec (&sym->ts), se.expr); if (sym->backend_decl == NULL) sym->backend_decl = gfc_get_symbol_decl (sym); ! gfc_add_modify_expr (&se.pre, sym->backend_decl, se.expr); } else gfc_add_expr_to_block (&se.pre, se.expr); --- 373,379 ---- se.expr = convert (gfc_typenode_for_spec (&sym->ts), se.expr); if (sym->backend_decl == NULL) sym->backend_decl = gfc_get_symbol_decl (sym); ! gfc_add_modify (&se.pre, sym->backend_decl, se.expr); } else gfc_add_expr_to_block (&se.pre, se.expr); *************** gfc_trans_call (gfc_code * code, bool de *** 368,374 **** gfc_se depse; /* gfc_walk_elemental_function_args renders the ss chain in the ! reverse order to the actual argument order. */ ss = gfc_reverse_ss (ss); /* Initialize the loop. */ --- 392,398 ---- gfc_se depse; /* gfc_walk_elemental_function_args renders the ss chain in the ! reverse order to the actual argument order. */ ss = gfc_reverse_ss (ss); /* Initialize the loop. */ *************** gfc_trans_call (gfc_code * code, bool de *** 381,387 **** subscripts. This could be prevented in the elemental case as temporaries are handled separatedly (below in gfc_conv_elemental_dependencies). */ ! gfc_conv_loop_setup (&loop); gfc_mark_ss_chain_used (ss, 1); /* Convert the arguments, checking for dependencies. */ --- 405,411 ---- subscripts. This could be prevented in the elemental case as temporaries are handled separatedly (below in gfc_conv_elemental_dependencies). */ ! gfc_conv_loop_setup (&loop, &code->expr->where); gfc_mark_ss_chain_used (ss, 1); /* Convert the arguments, checking for dependencies. */ *************** gfc_trans_return (gfc_code * code ATTRIB *** 455,462 **** gfc_conv_expr (&se, code->expr); ! tmp = build2 (MODIFY_EXPR, TREE_TYPE (result), result, ! fold_convert (TREE_TYPE (result), se.expr)); gfc_add_expr_to_block (&se.pre, tmp); tmp = build1_v (GOTO_EXPR, gfc_get_return_label ()); --- 479,486 ---- gfc_conv_expr (&se, code->expr); ! tmp = fold_build2 (MODIFY_EXPR, TREE_TYPE (result), result, ! fold_convert (TREE_TYPE (result), se.expr)); gfc_add_expr_to_block (&se.pre, tmp); tmp = build1_v (GOTO_EXPR, gfc_get_return_label ()); *************** gfc_trans_simple_do (gfc_code * code, st *** 743,749 **** type = TREE_TYPE (dovar); /* Initialize the DO variable: dovar = from. */ ! gfc_add_modify_expr (pblock, dovar, from); /* Cycle and exit statements are implemented with gotos. */ cycle_label = gfc_build_label_decl (NULL_TREE); --- 767,773 ---- type = TREE_TYPE (dovar); /* Initialize the DO variable: dovar = from. */ ! gfc_add_modify (pblock, dovar, from); /* Cycle and exit statements are implemented with gotos. */ cycle_label = gfc_build_label_decl (NULL_TREE); *************** gfc_trans_simple_do (gfc_code * code, st *** 772,778 **** /* Increment the loop variable. */ tmp = fold_build2 (PLUS_EXPR, type, dovar, step); ! gfc_add_modify_expr (&body, dovar, tmp); /* The loop exit. */ tmp = build1_v (GOTO_EXPR, exit_label); --- 796,802 ---- /* Increment the loop variable. */ tmp = fold_build2 (PLUS_EXPR, type, dovar, step); ! gfc_add_modify (&body, dovar, tmp); /* The loop exit. */ tmp = build1_v (GOTO_EXPR, exit_label); *************** gfc_trans_do (gfc_code * code) *** 843,849 **** tree from; tree to; tree step; - tree empty; tree countm1; tree type; tree utype; --- 867,872 ---- *************** gfc_trans_do (gfc_code * code) *** 884,939 **** && (integer_onep (step) || tree_int_cst_equal (step, integer_minus_one_node))) return gfc_trans_simple_do (code, &block, dovar, from, to, step); ! ! /* We need a special check for empty loops: ! empty = (step > 0 ? to < from : to > from); */ pos_step = fold_build2 (GT_EXPR, boolean_type_node, step, fold_convert (type, integer_zero_node)); - empty = fold_build3 (COND_EXPR, boolean_type_node, pos_step, - fold_build2 (LT_EXPR, boolean_type_node, to, from), - fold_build2 (GT_EXPR, boolean_type_node, to, from)); ! /* Initialize loop count. This code is executed before we enter the ! loop body. We generate: countm1 = abs(to - from) / abs(step). */ if (TREE_CODE (type) == INTEGER_TYPE) { ! tree ustep; ! utype = unsigned_type_for (type); ! /* tmp = abs(to - from) / abs(step) */ ! ustep = fold_convert (utype, fold_build1 (ABS_EXPR, type, step)); ! tmp = fold_build3 (COND_EXPR, type, pos_step, ! fold_build2 (MINUS_EXPR, type, to, from), ! fold_build2 (MINUS_EXPR, type, from, to)); ! tmp = fold_build2 (TRUNC_DIV_EXPR, utype, fold_convert (utype, tmp), ! ustep); } else { /* TODO: We could use the same width as the real type. This would probably cause more problems that it solves when we implement "long double" types. */ ! utype = unsigned_type_for (gfc_array_index_type); tmp = fold_build2 (MINUS_EXPR, type, to, from); tmp = fold_build2 (RDIV_EXPR, type, tmp, step); tmp = fold_build1 (FIX_TRUNC_EXPR, utype, tmp); ! } ! countm1 = gfc_create_var (utype, "countm1"); ! gfc_add_modify_expr (&block, countm1, tmp); ! ! /* Cycle and exit statements are implemented with gotos. */ ! cycle_label = gfc_build_label_decl (NULL_TREE); ! exit_label = gfc_build_label_decl (NULL_TREE); ! TREE_USED (exit_label) = 1; ! ! /* Initialize the DO variable: dovar = from. */ ! gfc_add_modify_expr (&block, dovar, from); ! /* If the loop is empty, go directly to the exit label. */ ! tmp = fold_build3 (COND_EXPR, void_type_node, empty, ! build1_v (GOTO_EXPR, exit_label), build_empty_stmt ()); ! gfc_add_expr_to_block (&block, tmp); /* Loop body. */ gfc_start_block (&body); --- 907,994 ---- && (integer_onep (step) || tree_int_cst_equal (step, integer_minus_one_node))) return gfc_trans_simple_do (code, &block, dovar, from, to, step); ! pos_step = fold_build2 (GT_EXPR, boolean_type_node, step, fold_convert (type, integer_zero_node)); ! if (TREE_CODE (type) == INTEGER_TYPE) ! utype = unsigned_type_for (type); ! else ! utype = unsigned_type_for (gfc_array_index_type); ! countm1 = gfc_create_var (utype, "countm1"); ! ! /* Cycle and exit statements are implemented with gotos. */ ! cycle_label = gfc_build_label_decl (NULL_TREE); ! exit_label = gfc_build_label_decl (NULL_TREE); ! TREE_USED (exit_label) = 1; ! ! /* Initialize the DO variable: dovar = from. */ ! gfc_add_modify (&block, dovar, from); ! ! /* Initialize loop count and jump to exit label if the loop is empty. ! This code is executed before we enter the loop body. We generate: ! if (step > 0) ! { ! if (to < from) goto exit_label; ! countm1 = (to - from) / step; ! } ! else ! { ! if (to > from) goto exit_label; ! countm1 = (from - to) / -step; ! } */ if (TREE_CODE (type) == INTEGER_TYPE) { ! tree pos, neg; ! tmp = fold_build2 (LT_EXPR, boolean_type_node, to, from); ! pos = fold_build3 (COND_EXPR, void_type_node, tmp, ! build1_v (GOTO_EXPR, exit_label), ! build_empty_stmt ()); ! tmp = fold_build2 (MINUS_EXPR, type, to, from); ! tmp = fold_convert (utype, tmp); ! tmp = fold_build2 (TRUNC_DIV_EXPR, utype, tmp, ! fold_convert (utype, step)); ! tmp = build2 (MODIFY_EXPR, void_type_node, countm1, tmp); ! pos = build2 (COMPOUND_EXPR, void_type_node, pos, tmp); ! tmp = fold_build2 (GT_EXPR, boolean_type_node, to, from); ! neg = fold_build3 (COND_EXPR, void_type_node, tmp, ! build1_v (GOTO_EXPR, exit_label), ! build_empty_stmt ()); ! tmp = fold_build2 (MINUS_EXPR, type, from, to); ! tmp = fold_convert (utype, tmp); ! tmp = fold_build2 (TRUNC_DIV_EXPR, utype, tmp, ! fold_convert (utype, fold_build1 (NEGATE_EXPR, ! type, step))); ! tmp = build2 (MODIFY_EXPR, void_type_node, countm1, tmp); ! neg = build2 (COMPOUND_EXPR, void_type_node, neg, tmp); ! ! tmp = fold_build3 (COND_EXPR, void_type_node, pos_step, pos, neg); ! gfc_add_expr_to_block (&block, tmp); } else { /* TODO: We could use the same width as the real type. This would probably cause more problems that it solves when we implement "long double" types. */ ! tmp = fold_build2 (MINUS_EXPR, type, to, from); tmp = fold_build2 (RDIV_EXPR, type, tmp, step); tmp = fold_build1 (FIX_TRUNC_EXPR, utype, tmp); ! gfc_add_modify (&block, countm1, tmp); ! /* We need a special check for empty loops: ! empty = (step > 0 ? to < from : to > from); */ ! tmp = fold_build3 (COND_EXPR, boolean_type_node, pos_step, ! fold_build2 (LT_EXPR, boolean_type_node, to, from), ! fold_build2 (GT_EXPR, boolean_type_node, to, from)); ! /* If the loop is empty, go directly to the exit label. */ ! tmp = fold_build3 (COND_EXPR, void_type_node, tmp, ! build1_v (GOTO_EXPR, exit_label), ! build_empty_stmt ()); ! gfc_add_expr_to_block (&block, tmp); ! } /* Loop body. */ gfc_start_block (&body); *************** gfc_trans_do (gfc_code * code) *** 957,964 **** } /* Increment the loop variable. */ ! tmp = build2 (PLUS_EXPR, type, dovar, step); ! gfc_add_modify_expr (&body, dovar, tmp); /* End with the loop condition. Loop until countm1 == 0. */ cond = fold_build2 (EQ_EXPR, boolean_type_node, countm1, --- 1012,1019 ---- } /* Increment the loop variable. */ ! tmp = fold_build2 (PLUS_EXPR, type, dovar, step); ! gfc_add_modify (&body, dovar, tmp); /* End with the loop condition. Loop until countm1 == 0. */ cond = fold_build2 (EQ_EXPR, boolean_type_node, countm1, *************** gfc_trans_do (gfc_code * code) *** 969,976 **** gfc_add_expr_to_block (&body, tmp); /* Decrement the loop count. */ ! tmp = build2 (MINUS_EXPR, utype, countm1, build_int_cst (utype, 1)); ! gfc_add_modify_expr (&body, countm1, tmp); /* End of loop body. */ tmp = gfc_finish_block (&body); --- 1024,1031 ---- gfc_add_expr_to_block (&body, tmp); /* Decrement the loop count. */ ! tmp = fold_build2 (MINUS_EXPR, utype, countm1, build_int_cst (utype, 1)); ! gfc_add_modify (&body, countm1, tmp); /* End of loop body. */ tmp = gfc_finish_block (&body); *************** gfc_trans_integer_select (gfc_code * cod *** 1192,1198 **** /* Add this case label. Add parameter 'label', make it match GCC backend. */ ! tmp = build3 (CASE_LABEL_EXPR, void_type_node, low, high, label); gfc_add_expr_to_block (&body, tmp); } --- 1247,1254 ---- /* Add this case label. Add parameter 'label', make it match GCC backend. */ ! tmp = fold_build3 (CASE_LABEL_EXPR, void_type_node, ! low, high, label); gfc_add_expr_to_block (&body, tmp); } *************** gfc_trans_logical_select (gfc_code * cod *** 1328,1368 **** static tree gfc_trans_character_select (gfc_code *code) { ! tree init, node, end_label, tmp, type, case_num, label; stmtblock_t block, body; gfc_case *cp, *d; gfc_code *c; gfc_se se; ! int n; ! static tree select_struct; ! static tree ss_string1, ss_string1_len; ! static tree ss_string2, ss_string2_len; ! static tree ss_target; ! if (select_struct == NULL) { ! tree gfc_int4_type_node = gfc_get_int_type (4); ! select_struct = make_node (RECORD_TYPE); ! TYPE_NAME (select_struct) = get_identifier ("_jump_struct"); #undef ADD_FIELD ! #define ADD_FIELD(NAME, TYPE) \ ! ss_##NAME = gfc_add_field_to_struct \ ! (&(TYPE_FIELDS (select_struct)), select_struct, \ get_identifier (stringize(NAME)), TYPE) ! ADD_FIELD (string1, pchar_type_node); ! ADD_FIELD (string1_len, gfc_int4_type_node); ! ADD_FIELD (string2, pchar_type_node); ! ADD_FIELD (string2_len, gfc_int4_type_node); ADD_FIELD (target, integer_type_node); #undef ADD_FIELD ! gfc_finish_type (select_struct); } cp = code->block->ext.case_list; --- 1384,1439 ---- static tree gfc_trans_character_select (gfc_code *code) { ! tree init, node, end_label, tmp, type, case_num, label, fndecl; stmtblock_t block, body; gfc_case *cp, *d; gfc_code *c; gfc_se se; ! int n, k; ! /* The jump table types are stored in static variables to avoid ! constructing them from scratch every single time. */ ! static tree select_struct[2]; ! static tree ss_string1[2], ss_string1_len[2]; ! static tree ss_string2[2], ss_string2_len[2]; ! static tree ss_target[2]; ! tree pchartype = gfc_get_pchar_type (code->expr->ts.kind); ! ! if (code->expr->ts.kind == 1) ! k = 0; ! else if (code->expr->ts.kind == 4) ! k = 1; ! else ! gcc_unreachable (); ! ! if (select_struct[k] == NULL) { ! select_struct[k] = make_node (RECORD_TYPE); ! if (code->expr->ts.kind == 1) ! TYPE_NAME (select_struct[k]) = get_identifier ("_jump_struct_char1"); ! else if (code->expr->ts.kind == 4) ! TYPE_NAME (select_struct[k]) = get_identifier ("_jump_struct_char4"); ! else ! gcc_unreachable (); #undef ADD_FIELD ! #define ADD_FIELD(NAME, TYPE) \ ! ss_##NAME[k] = gfc_add_field_to_struct \ ! (&(TYPE_FIELDS (select_struct[k])), select_struct[k], \ get_identifier (stringize(NAME)), TYPE) ! ADD_FIELD (string1, pchartype); ! ADD_FIELD (string1_len, gfc_charlen_type_node); ! ADD_FIELD (string2, pchartype); ! ADD_FIELD (string2_len, gfc_charlen_type_node); ADD_FIELD (target, integer_type_node); #undef ADD_FIELD ! gfc_finish_type (select_struct[k]); } cp = code->block->ext.case_list; *************** gfc_trans_character_select (gfc_code *co *** 1384,1392 **** for (d = c->ext.case_list; d; d = d->next) { label = gfc_build_label_decl (NULL_TREE); ! tmp = build3 (CASE_LABEL_EXPR, void_type_node, ! build_int_cst (NULL_TREE, d->n), ! build_int_cst (NULL_TREE, d->n), label); gfc_add_expr_to_block (&body, tmp); } --- 1455,1463 ---- for (d = c->ext.case_list; d; d = d->next) { label = gfc_build_label_decl (NULL_TREE); ! tmp = fold_build3 (CASE_LABEL_EXPR, void_type_node, ! build_int_cst (NULL_TREE, d->n), ! build_int_cst (NULL_TREE, d->n), label); gfc_add_expr_to_block (&body, tmp); } *************** gfc_trans_character_select (gfc_code *co *** 1408,1456 **** if (d->low == NULL) { ! node = tree_cons (ss_string1, null_pointer_node, node); ! node = tree_cons (ss_string1_len, integer_zero_node, node); } else { gfc_conv_expr_reference (&se, d->low); ! node = tree_cons (ss_string1, se.expr, node); ! node = tree_cons (ss_string1_len, se.string_length, node); } if (d->high == NULL) { ! node = tree_cons (ss_string2, null_pointer_node, node); ! node = tree_cons (ss_string2_len, integer_zero_node, node); } else { gfc_init_se (&se, NULL); gfc_conv_expr_reference (&se, d->high); ! node = tree_cons (ss_string2, se.expr, node); ! node = tree_cons (ss_string2_len, se.string_length, node); } ! node = tree_cons (ss_target, build_int_cst (integer_type_node, d->n), node); ! tmp = build_constructor_from_list (select_struct, nreverse (node)); init = tree_cons (NULL_TREE, tmp, init); } ! type = build_array_type (select_struct, build_index_type ! (build_int_cst (NULL_TREE, n - 1))); init = build_constructor_from_list (type, nreverse(init)); TREE_CONSTANT (init) = 1; - TREE_INVARIANT (init) = 1; TREE_STATIC (init) = 1; /* Create a static variable to hold the jump table. */ tmp = gfc_create_var (type, "jumptable"); TREE_CONSTANT (tmp) = 1; - TREE_INVARIANT (tmp) = 1; TREE_STATIC (tmp) = 1; TREE_READONLY (tmp) = 1; DECL_INITIAL (tmp) = init; --- 1479,1525 ---- if (d->low == NULL) { ! node = tree_cons (ss_string1[k], null_pointer_node, node); ! node = tree_cons (ss_string1_len[k], integer_zero_node, node); } else { gfc_conv_expr_reference (&se, d->low); ! node = tree_cons (ss_string1[k], se.expr, node); ! node = tree_cons (ss_string1_len[k], se.string_length, node); } if (d->high == NULL) { ! node = tree_cons (ss_string2[k], null_pointer_node, node); ! node = tree_cons (ss_string2_len[k], integer_zero_node, node); } else { gfc_init_se (&se, NULL); gfc_conv_expr_reference (&se, d->high); ! node = tree_cons (ss_string2[k], se.expr, node); ! node = tree_cons (ss_string2_len[k], se.string_length, node); } ! node = tree_cons (ss_target[k], build_int_cst (integer_type_node, d->n), node); ! tmp = build_constructor_from_list (select_struct[k], nreverse (node)); init = tree_cons (NULL_TREE, tmp, init); } ! type = build_array_type (select_struct[k], ! build_index_type (build_int_cst (NULL_TREE, n-1))); init = build_constructor_from_list (type, nreverse(init)); TREE_CONSTANT (init) = 1; TREE_STATIC (init) = 1; /* Create a static variable to hold the jump table. */ tmp = gfc_create_var (type, "jumptable"); TREE_CONSTANT (tmp) = 1; TREE_STATIC (tmp) = 1; TREE_READONLY (tmp) = 1; DECL_INITIAL (tmp) = init; *************** gfc_trans_character_select (gfc_code *co *** 1464,1474 **** gfc_add_block_to_block (&block, &se.pre); ! tmp = build_call_expr (gfor_fndecl_select_string, 4, init, ! build_int_cst (NULL_TREE, n), se.expr, ! se.string_length); case_num = gfc_create_var (integer_type_node, "case_num"); ! gfc_add_modify_expr (&block, case_num, tmp); gfc_add_block_to_block (&block, &se.post); --- 1533,1549 ---- gfc_add_block_to_block (&block, &se.pre); ! if (code->expr->ts.kind == 1) ! fndecl = gfor_fndecl_select_string; ! else if (code->expr->ts.kind == 4) ! fndecl = gfor_fndecl_select_string_char4; ! else ! gcc_unreachable (); ! ! tmp = build_call_expr (fndecl, 4, init, build_int_cst (NULL_TREE, n), ! se.expr, se.string_length); case_num = gfc_create_var (integer_type_node, "case_num"); ! gfc_add_modify (&block, case_num, tmp); gfc_add_block_to_block (&block, &se.post); *************** forall_make_variable_temp (gfc_code *c, *** 1598,1604 **** { /* Use the variable offset for the temporary. */ tmp = gfc_conv_descriptor_offset (tse.expr); ! gfc_add_modify_expr (pre, tmp, gfc_conv_array_offset (old_sym->backend_decl)); } } --- 1673,1679 ---- { /* Use the variable offset for the temporary. */ tmp = gfc_conv_descriptor_offset (tse.expr); ! gfc_add_modify (pre, tmp, gfc_conv_array_offset (old_sym->backend_decl)); } } *************** gfc_trans_forall_loop (forall_info *fora *** 1754,1760 **** /* Initialize the mask index outside the FORALL nest. */ if (mask_flag && forall_tmp->mask) ! gfc_add_modify_expr (outer, forall_tmp->maskindex, gfc_index_zero_node); iter = forall_tmp->this_loop; nvar = forall_tmp->nvar; --- 1829,1835 ---- /* Initialize the mask index outside the FORALL nest. */ if (mask_flag && forall_tmp->mask) ! gfc_add_modify (outer, forall_tmp->maskindex, gfc_index_zero_node); iter = forall_tmp->this_loop; nvar = forall_tmp->nvar; *************** gfc_trans_forall_loop (forall_info *fora *** 1786,1821 **** gfc_add_expr_to_block (&block, body); /* Increment the loop variable. */ ! tmp = build2 (PLUS_EXPR, TREE_TYPE (var), var, step); ! gfc_add_modify_expr (&block, var, tmp); /* Advance to the next mask element. Only do this for the innermost loop. */ if (n == 0 && mask_flag && forall_tmp->mask) { tree maskindex = forall_tmp->maskindex; ! tmp = build2 (PLUS_EXPR, gfc_array_index_type, ! maskindex, gfc_index_one_node); ! gfc_add_modify_expr (&block, maskindex, tmp); } /* Decrement the loop counter. */ ! tmp = build2 (MINUS_EXPR, TREE_TYPE (var), count, ! build_int_cst (TREE_TYPE (var), 1)); ! gfc_add_modify_expr (&block, count, tmp); body = gfc_finish_block (&block); /* Loop var initialization. */ gfc_init_block (&block); ! gfc_add_modify_expr (&block, var, start); /* Initialize the loop counter. */ tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (var), step, start); tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (var), end, tmp); tmp = fold_build2 (TRUNC_DIV_EXPR, TREE_TYPE (var), tmp, step); ! gfc_add_modify_expr (&block, count, tmp); /* The loop expression. */ tmp = build1_v (LOOP_EXPR, body); --- 1861,1896 ---- gfc_add_expr_to_block (&block, body); /* Increment the loop variable. */ ! tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (var), var, step); ! gfc_add_modify (&block, var, tmp); /* Advance to the next mask element. Only do this for the innermost loop. */ if (n == 0 && mask_flag && forall_tmp->mask) { tree maskindex = forall_tmp->maskindex; ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! maskindex, gfc_index_one_node); ! gfc_add_modify (&block, maskindex, tmp); } /* Decrement the loop counter. */ ! tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (var), count, ! build_int_cst (TREE_TYPE (var), 1)); ! gfc_add_modify (&block, count, tmp); body = gfc_finish_block (&block); /* Loop var initialization. */ gfc_init_block (&block); ! gfc_add_modify (&block, var, start); /* Initialize the loop counter. */ tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (var), step, start); tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (var), end, tmp); tmp = fold_build2 (TRUNC_DIV_EXPR, TREE_TYPE (var), tmp, step); ! gfc_add_modify (&block, count, tmp); /* The loop expression. */ tmp = build1_v (LOOP_EXPR, body); *************** gfc_do_allocate (tree bytesize, tree siz *** 1907,1913 **** *pdata = convert (pvoid_type_node, tmpvar); tmp = gfc_call_malloc (pblock, TREE_TYPE (tmpvar), bytesize); ! gfc_add_modify_expr (pblock, tmpvar, tmp); } return tmpvar; } --- 1982,1988 ---- *pdata = convert (pvoid_type_node, tmpvar); tmp = gfc_call_malloc (pblock, TREE_TYPE (tmpvar), bytesize); ! gfc_add_modify (pblock, tmpvar, tmp); } return tmpvar; } *************** generate_loop_for_temp_to_lhs (gfc_expr *** 1943,1955 **** /* Use the scalar assignment as is. */ gfc_add_block_to_block (&block, &lse.pre); ! gfc_add_modify_expr (&block, lse.expr, tmp); gfc_add_block_to_block (&block, &lse.post); /* Increment the count1. */ tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (count1), count1, gfc_index_one_node); ! gfc_add_modify_expr (&block, count1, tmp); tmp = gfc_finish_block (&block); } --- 2018,2030 ---- /* 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 (PLUS_EXPR, TREE_TYPE (count1), count1, gfc_index_one_node); ! gfc_add_modify (&block, count1, tmp); tmp = gfc_finish_block (&block); } *************** generate_loop_for_temp_to_lhs (gfc_expr *** 1967,1973 **** /* Calculate the bounds of the scalarization. */ gfc_conv_ss_startstride (&loop1); /* Setup the scalarizing loops. */ ! gfc_conv_loop_setup (&loop1); gfc_mark_ss_chain_used (lss, 1); --- 2042,2048 ---- /* Calculate the bounds of the scalarization. */ gfc_conv_ss_startstride (&loop1); /* Setup the scalarizing loops. */ ! gfc_conv_loop_setup (&loop1, &expr->where); gfc_mark_ss_chain_used (lss, 1); *************** generate_loop_for_temp_to_lhs (gfc_expr *** 2005,2018 **** /* Increment count1. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count1, gfc_index_one_node); ! gfc_add_modify_expr (&body, count1, tmp); /* Increment count3. */ if (count3) { tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count3, gfc_index_one_node); ! gfc_add_modify_expr (&body, count3, tmp); } /* Generate the copying loops. */ --- 2080,2093 ---- /* Increment count1. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count1, gfc_index_one_node); ! gfc_add_modify (&body, count1, tmp); /* Increment count3. */ if (count3) { tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count3, gfc_index_one_node); ! gfc_add_modify (&body, count3, tmp); } /* Generate the copying loops. */ *************** generate_loop_for_rhs_to_temp (gfc_expr *** 2065,2071 **** gfc_add_ss_to_loop (&loop, rss); gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop); gfc_mark_ss_chain_used (rss, 1); /* Start the loop body. */ --- 2140,2146 ---- gfc_add_ss_to_loop (&loop, rss); gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop, &expr2->where); gfc_mark_ss_chain_used (rss, 1); /* Start the loop body. */ *************** generate_loop_for_rhs_to_temp (gfc_expr *** 2106,2126 **** /* Increment count1. */ tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (count1), count1, gfc_index_one_node); ! gfc_add_modify_expr (&block, count1, tmp); } else { /* Increment count1. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count1, gfc_index_one_node); ! gfc_add_modify_expr (&body1, count1, tmp); /* Increment count3. */ if (count3) { tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count3, gfc_index_one_node); ! gfc_add_modify_expr (&body1, count3, tmp); } /* Generate the copying loops. */ --- 2181,2201 ---- /* Increment count1. */ tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (count1), count1, gfc_index_one_node); ! gfc_add_modify (&block, count1, tmp); } else { /* Increment count1. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count1, gfc_index_one_node); ! gfc_add_modify (&body1, count1, tmp); /* Increment count3. */ if (count3) { tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count3, gfc_index_one_node); ! gfc_add_modify (&body1, count3, tmp); } /* Generate the copying loops. */ *************** compute_inner_temp_size (gfc_expr *expr1 *** 2187,2193 **** flag_bounds_check = 0; gfc_conv_ss_startstride (&loop); flag_bounds_check = save_flag; ! gfc_conv_loop_setup (&loop); /* Figure out how many elements we need. */ for (i = 0; i < loop.dimen; i++) --- 2262,2268 ---- flag_bounds_check = 0; gfc_conv_ss_startstride (&loop); flag_bounds_check = save_flag; ! gfc_conv_loop_setup (&loop, &expr2->where); /* Figure out how many elements we need. */ for (i = 0; i < loop.dimen; i++) *************** compute_overall_iter_number (forall_info *** 2246,2262 **** /* Otherwise, create a temporary variable to compute the result. */ number = gfc_create_var (gfc_array_index_type, "num"); ! gfc_add_modify_expr (block, number, gfc_index_zero_node); gfc_start_block (&body); if (inner_size_body) gfc_add_block_to_block (&body, inner_size_body); if (forall_tmp) ! tmp = build2 (PLUS_EXPR, gfc_array_index_type, number, ! inner_size); else tmp = inner_size; ! gfc_add_modify_expr (&body, number, tmp); tmp = gfc_finish_block (&body); /* Generate loops. */ --- 2321,2337 ---- /* Otherwise, create a temporary variable to compute the result. */ number = gfc_create_var (gfc_array_index_type, "num"); ! gfc_add_modify (block, number, gfc_index_zero_node); gfc_start_block (&body); if (inner_size_body) gfc_add_block_to_block (&body, inner_size_body); if (forall_tmp) ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! number, inner_size); else tmp = inner_size; ! gfc_add_modify (&body, number, tmp); tmp = gfc_finish_block (&body); /* Generate loops. */ *************** gfc_trans_assign_need_temp (gfc_expr * e *** 2367,2379 **** if (wheremask) { count = gfc_create_var (gfc_array_index_type, "count"); ! gfc_add_modify_expr (block, count, gfc_index_zero_node); } else count = NULL; /* Initialize count1. */ ! gfc_add_modify_expr (block, count1, gfc_index_zero_node); /* 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(). */ --- 2442,2454 ---- if (wheremask) { count = gfc_create_var (gfc_array_index_type, "count"); ! gfc_add_modify (block, count, gfc_index_zero_node); } else count = NULL; /* Initialize count1. */ ! gfc_add_modify (block, count1, gfc_index_zero_node); /* 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_trans_assign_need_temp (gfc_expr * e *** 2412,2422 **** gfc_add_expr_to_block (block, tmp); /* Reset count1. */ ! gfc_add_modify_expr (block, count1, gfc_index_zero_node); /* Reset count. */ if (wheremask) ! gfc_add_modify_expr (block, count, gfc_index_zero_node); /* Generate codes to copy the temporary to lhs. */ tmp = generate_loop_for_temp_to_lhs (expr1, tmp1, count, count1, --- 2487,2497 ---- gfc_add_expr_to_block (block, tmp); /* Reset count1. */ ! gfc_add_modify (block, count1, gfc_index_zero_node); /* Reset count. */ if (wheremask) ! gfc_add_modify (block, count, gfc_index_zero_node); /* Generate codes to copy the temporary to lhs. */ tmp = generate_loop_for_temp_to_lhs (expr1, tmp1, count, count1, *************** gfc_trans_pointer_assign_need_temp (gfc_ *** 2458,2464 **** tree tmp, tmp1, ptemp1; count = gfc_create_var (gfc_array_index_type, "count"); ! gfc_add_modify_expr (block, count, gfc_index_zero_node); inner_size = integer_one_node; lss = gfc_walk_expr (expr1); --- 2533,2539 ---- tree tmp, tmp1, ptemp1; count = gfc_create_var (gfc_array_index_type, "count"); ! gfc_add_modify (block, count, gfc_index_zero_node); inner_size = integer_one_node; lss = gfc_walk_expr (expr1); *************** gfc_trans_pointer_assign_need_temp (gfc_ *** 2479,2492 **** rse.want_pointer = 1; gfc_conv_expr (&rse, expr2); gfc_add_block_to_block (&body, &rse.pre); ! gfc_add_modify_expr (&body, lse.expr, fold_convert (TREE_TYPE (lse.expr), rse.expr)); gfc_add_block_to_block (&body, &rse.post); /* Increment count. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count, gfc_index_one_node); ! gfc_add_modify_expr (&body, count, tmp); tmp = gfc_finish_block (&body); --- 2554,2567 ---- rse.want_pointer = 1; gfc_conv_expr (&rse, expr2); gfc_add_block_to_block (&body, &rse.pre); ! gfc_add_modify (&body, lse.expr, fold_convert (TREE_TYPE (lse.expr), rse.expr)); gfc_add_block_to_block (&body, &rse.post); /* Increment count. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count, gfc_index_one_node); ! gfc_add_modify (&body, count, tmp); tmp = gfc_finish_block (&body); *************** gfc_trans_pointer_assign_need_temp (gfc_ *** 2496,2502 **** gfc_add_expr_to_block (block, tmp); /* Reset count. */ ! gfc_add_modify_expr (block, count, gfc_index_zero_node); gfc_start_block (&body); gfc_init_se (&lse, NULL); --- 2571,2577 ---- gfc_add_expr_to_block (block, tmp); /* Reset count. */ ! gfc_add_modify (block, count, gfc_index_zero_node); gfc_start_block (&body); gfc_init_se (&lse, NULL); *************** gfc_trans_pointer_assign_need_temp (gfc_ *** 2505,2516 **** lse.want_pointer = 1; gfc_conv_expr (&lse, expr1); gfc_add_block_to_block (&body, &lse.pre); ! gfc_add_modify_expr (&body, lse.expr, rse.expr); gfc_add_block_to_block (&body, &lse.post); /* Increment count. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count, gfc_index_one_node); ! gfc_add_modify_expr (&body, count, tmp); tmp = gfc_finish_block (&body); /* Generate body and loops according to the information in --- 2580,2591 ---- lse.want_pointer = 1; gfc_conv_expr (&lse, expr1); gfc_add_block_to_block (&body, &lse.pre); ! gfc_add_modify (&body, lse.expr, rse.expr); gfc_add_block_to_block (&body, &lse.post); /* Increment count. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count, gfc_index_one_node); ! gfc_add_modify (&body, count, tmp); tmp = gfc_finish_block (&body); /* Generate body and loops according to the information in *************** gfc_trans_pointer_assign_need_temp (gfc_ *** 2528,2534 **** /* Setup the scalarizing loops and bounds. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop); info = &rss->data.info; desc = info->descriptor; --- 2603,2609 ---- /* Setup the scalarizing loops and bounds. */ gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop, &expr2->where); info = &rss->data.info; desc = info->descriptor; *************** gfc_trans_pointer_assign_need_temp (gfc_ *** 2555,2561 **** /* Increment count. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count, gfc_index_one_node); ! gfc_add_modify_expr (&body, count, tmp); tmp = gfc_finish_block (&body); --- 2630,2636 ---- /* Increment count. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count, gfc_index_one_node); ! gfc_add_modify (&body, count, tmp); tmp = gfc_finish_block (&body); *************** gfc_trans_pointer_assign_need_temp (gfc_ *** 2565,2577 **** gfc_add_expr_to_block (block, tmp); /* Reset count. */ ! gfc_add_modify_expr (block, count, gfc_index_zero_node); parm = gfc_build_array_ref (tmp1, count, NULL); lss = gfc_walk_expr (expr1); gfc_init_se (&lse, NULL); gfc_conv_expr_descriptor (&lse, expr1, lss); ! gfc_add_modify_expr (&lse.pre, lse.expr, parm); gfc_start_block (&body); gfc_add_block_to_block (&body, &lse.pre); gfc_add_block_to_block (&body, &lse.post); --- 2640,2652 ---- gfc_add_expr_to_block (block, tmp); /* Reset count. */ ! gfc_add_modify (block, count, gfc_index_zero_node); parm = gfc_build_array_ref (tmp1, count, NULL); lss = gfc_walk_expr (expr1); gfc_init_se (&lse, NULL); gfc_conv_expr_descriptor (&lse, expr1, lss); ! gfc_add_modify (&lse.pre, lse.expr, parm); gfc_start_block (&body); gfc_add_block_to_block (&body, &lse.pre); gfc_add_block_to_block (&body, &lse.post); *************** gfc_trans_pointer_assign_need_temp (gfc_ *** 2579,2585 **** /* Increment count. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count, gfc_index_one_node); ! gfc_add_modify_expr (&body, count, tmp); tmp = gfc_finish_block (&body); --- 2654,2660 ---- /* Increment count. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count, gfc_index_one_node); ! gfc_add_modify (&body, count, tmp); tmp = gfc_finish_block (&body); *************** gfc_trans_forall_1 (gfc_code * code, for *** 2811,2817 **** /* As the mask array can be very big, prefer compact boolean types. */ tree mask_type = gfc_get_logical_type (gfc_logical_kinds[0].kind); ! gfc_add_modify_expr (&block, maskindex, gfc_index_zero_node); /* Start of mask assignment loop body. */ gfc_start_block (&body); --- 2886,2892 ---- /* As the mask array can be very big, prefer compact boolean types. */ tree mask_type = gfc_get_logical_type (gfc_logical_kinds[0].kind); ! gfc_add_modify (&block, maskindex, gfc_index_zero_node); /* Start of mask assignment loop body. */ gfc_start_block (&body); *************** gfc_trans_forall_1 (gfc_code * code, for *** 2825,2836 **** se.expr = convert (mask_type, se.expr); tmp = gfc_build_array_ref (mask, maskindex, NULL); ! gfc_add_modify_expr (&body, tmp, se.expr); /* Advance to the next mask element. */ ! tmp = build2 (PLUS_EXPR, gfc_array_index_type, ! maskindex, gfc_index_one_node); ! gfc_add_modify_expr (&body, maskindex, tmp); /* Generate the loops. */ tmp = gfc_finish_block (&body); --- 2900,2911 ---- se.expr = convert (mask_type, se.expr); tmp = gfc_build_array_ref (mask, maskindex, NULL); ! gfc_add_modify (&body, tmp, se.expr); /* Advance to the next mask element. */ ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! maskindex, gfc_index_one_node); ! gfc_add_modify (&body, maskindex, tmp); /* Generate the loops. */ tmp = gfc_finish_block (&body); *************** gfc_evaluate_where_mask (gfc_expr * me, *** 2988,2994 **** /* Variable to index the temporary. */ count = gfc_create_var (gfc_array_index_type, "count"); /* Initialize count. */ ! gfc_add_modify_expr (block, count, gfc_index_zero_node); gfc_start_block (&body); --- 3063,3069 ---- /* Variable to index the temporary. */ count = gfc_create_var (gfc_array_index_type, "count"); /* Initialize count. */ ! gfc_add_modify (block, count, gfc_index_zero_node); gfc_start_block (&body); *************** gfc_evaluate_where_mask (gfc_expr * me, *** 3009,3015 **** gfc_add_ss_to_loop (&loop, rss); gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop); gfc_mark_ss_chain_used (rss, 1); /* Start the loop body. */ --- 3084,3090 ---- gfc_add_ss_to_loop (&loop, rss); gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop, &me->where); gfc_mark_ss_chain_used (rss, 1); /* Start the loop body. */ *************** gfc_evaluate_where_mask (gfc_expr * me, *** 3030,3043 **** gfc_add_block_to_block (&body1, &lse.pre); gfc_add_block_to_block (&body1, &rse.pre); ! gfc_add_modify_expr (&body1, cond, fold_convert (mask_type, rse.expr)); if (mask && (cmask || pmask)) { tmp = gfc_build_array_ref (mask, count, NULL); if (invert) tmp = fold_build1 (TRUTH_NOT_EXPR, mask_type, tmp); ! gfc_add_modify_expr (&body1, mtmp, tmp); } if (cmask) --- 3105,3118 ---- gfc_add_block_to_block (&body1, &lse.pre); gfc_add_block_to_block (&body1, &rse.pre); ! gfc_add_modify (&body1, cond, fold_convert (mask_type, rse.expr)); if (mask && (cmask || pmask)) { tmp = gfc_build_array_ref (mask, count, NULL); if (invert) tmp = fold_build1 (TRUTH_NOT_EXPR, mask_type, tmp); ! gfc_add_modify (&body1, mtmp, tmp); } if (cmask) *************** gfc_evaluate_where_mask (gfc_expr * me, *** 3045,3061 **** tmp1 = gfc_build_array_ref (cmask, count, NULL); tmp = cond; if (mask) ! tmp = build2 (TRUTH_AND_EXPR, mask_type, mtmp, tmp); ! gfc_add_modify_expr (&body1, tmp1, tmp); } if (pmask) { tmp1 = gfc_build_array_ref (pmask, count, NULL); ! tmp = build1 (TRUTH_NOT_EXPR, mask_type, cond); if (mask) ! tmp = build2 (TRUTH_AND_EXPR, mask_type, mtmp, tmp); ! gfc_add_modify_expr (&body1, tmp1, tmp); } gfc_add_block_to_block (&body1, &lse.post); --- 3120,3136 ---- tmp1 = gfc_build_array_ref (cmask, count, NULL); tmp = cond; if (mask) ! tmp = fold_build2 (TRUTH_AND_EXPR, mask_type, mtmp, tmp); ! gfc_add_modify (&body1, tmp1, tmp); } if (pmask) { tmp1 = gfc_build_array_ref (pmask, count, NULL); ! tmp = fold_build1 (TRUTH_NOT_EXPR, mask_type, cond); if (mask) ! tmp = fold_build2 (TRUTH_AND_EXPR, mask_type, mtmp, tmp); ! gfc_add_modify (&body1, tmp1, tmp); } gfc_add_block_to_block (&body1, &lse.post); *************** gfc_evaluate_where_mask (gfc_expr * me, *** 3070,3076 **** /* Increment count. */ tmp1 = fold_build2 (PLUS_EXPR, gfc_array_index_type, count, gfc_index_one_node); ! gfc_add_modify_expr (&body1, count, tmp1); /* Generate the copying loops. */ gfc_trans_scalarizing_loops (&loop, &body1); --- 3145,3151 ---- /* Increment count. */ tmp1 = fold_build2 (PLUS_EXPR, gfc_array_index_type, count, gfc_index_one_node); ! gfc_add_modify (&body1, count, tmp1); /* Generate the copying loops. */ gfc_trans_scalarizing_loops (&loop, &body1); *************** gfc_trans_where_assign (gfc_expr *expr1, *** 3176,3182 **** gfc_conv_resolve_dependencies (&loop, lss_section, rss); /* Setup the scalarizing loops. */ ! gfc_conv_loop_setup (&loop); /* Setup the gfc_se structures. */ gfc_copy_loopinfo_to_se (&lse, &loop); --- 3251,3257 ---- gfc_conv_resolve_dependencies (&loop, lss_section, rss); /* Setup the scalarizing loops. */ ! gfc_conv_loop_setup (&loop, &expr2->where); /* Setup the gfc_se structures. */ gfc_copy_loopinfo_to_se (&lse, &loop); *************** gfc_trans_where_assign (gfc_expr *expr1, *** 3231,3237 **** /* Increment count1. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count1, gfc_index_one_node); ! gfc_add_modify_expr (&body, count1, tmp); /* Use the scalar assignment as is. */ gfc_add_block_to_block (&block, &body); --- 3306,3312 ---- /* Increment count1. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count1, gfc_index_one_node); ! gfc_add_modify (&body, count1, tmp); /* Use the scalar assignment as is. */ gfc_add_block_to_block (&block, &body); *************** gfc_trans_where_assign (gfc_expr *expr1, *** 3247,3253 **** expression. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count1, gfc_index_one_node); ! gfc_add_modify_expr (&body, count1, tmp); gfc_trans_scalarized_loop_boundary (&loop, &body); /* We need to copy the temporary to the actual lhs. */ --- 3322,3328 ---- expression. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count1, gfc_index_one_node); ! gfc_add_modify (&body, count1, tmp); gfc_trans_scalarized_loop_boundary (&loop, &body); /* We need to copy the temporary to the actual lhs. */ *************** gfc_trans_where_assign (gfc_expr *expr1, *** 3281,3294 **** /* Increment count2. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count2, gfc_index_one_node); ! gfc_add_modify_expr (&body, count2, tmp); } else { /* Increment count1. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count1, gfc_index_one_node); ! gfc_add_modify_expr (&body, count1, tmp); } /* Generate the copying loops. */ --- 3356,3369 ---- /* Increment count2. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count2, gfc_index_one_node); ! gfc_add_modify (&body, count2, tmp); } else { /* Increment count1. */ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, count1, gfc_index_one_node); ! gfc_add_modify (&body, count1, tmp); } /* Generate the copying loops. */ *************** gfc_trans_where_2 (gfc_code * code, tree *** 3481,3488 **** /* Variables to control maskexpr. */ count1 = gfc_create_var (gfc_array_index_type, "count1"); count2 = gfc_create_var (gfc_array_index_type, "count2"); ! gfc_add_modify_expr (block, count1, gfc_index_zero_node); ! gfc_add_modify_expr (block, count2, gfc_index_zero_node); tmp = gfc_trans_where_assign (expr1, expr2, cmask, invert, --- 3556,3563 ---- /* Variables to control maskexpr. */ count1 = gfc_create_var (gfc_array_index_type, "count1"); count2 = gfc_create_var (gfc_array_index_type, "count2"); ! gfc_add_modify (block, count1, gfc_index_zero_node); ! gfc_add_modify (block, count2, gfc_index_zero_node); tmp = gfc_trans_where_assign (expr1, expr2, cmask, invert, *************** gfc_trans_where_2 (gfc_code * code, tree *** 3499,3506 **** /* Variables to control maskexpr. */ count1 = gfc_create_var (gfc_array_index_type, "count1"); count2 = gfc_create_var (gfc_array_index_type, "count2"); ! gfc_add_modify_expr (block, count1, gfc_index_zero_node); ! gfc_add_modify_expr (block, count2, gfc_index_zero_node); tmp = gfc_trans_where_assign (expr1, expr2, cmask, invert, --- 3574,3581 ---- /* Variables to control maskexpr. */ count1 = gfc_create_var (gfc_array_index_type, "count1"); count2 = gfc_create_var (gfc_array_index_type, "count2"); ! gfc_add_modify (block, count1, gfc_index_zero_node); ! gfc_add_modify (block, count2, gfc_index_zero_node); tmp = gfc_trans_where_assign (expr1, expr2, cmask, invert, *************** gfc_trans_where_3 (gfc_code * cblock, gf *** 3624,3630 **** } gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop); gfc_mark_ss_chain_used (css, 1); gfc_mark_ss_chain_used (tdss, 1); --- 3699,3705 ---- } gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop, &tdst->where); gfc_mark_ss_chain_used (css, 1); gfc_mark_ss_chain_used (tdss, 1); *************** gfc_trans_allocate (gfc_code * code) *** 3846,3853 **** tmp = se.string_length; tmp = gfc_allocate_with_status (&se.pre, tmp, pstat); ! tmp = build2 (MODIFY_EXPR, void_type_node, se.expr, ! fold_convert (TREE_TYPE (se.expr), tmp)); gfc_add_expr_to_block (&se.pre, tmp); if (code->expr) --- 3921,3928 ---- tmp = se.string_length; tmp = gfc_allocate_with_status (&se.pre, tmp, pstat); ! tmp = fold_build2 (MODIFY_EXPR, void_type_node, se.expr, ! fold_convert (TREE_TYPE (se.expr), tmp)); gfc_add_expr_to_block (&se.pre, tmp); if (code->expr) *************** gfc_trans_allocate (gfc_code * code) *** 3882,3888 **** gfc_init_se (&se, NULL); gfc_conv_expr_lhs (&se, code->expr); tmp = convert (TREE_TYPE (se.expr), stat); ! gfc_add_modify_expr (&block, se.expr, tmp); } return gfc_finish_block (&block); --- 3957,3963 ---- gfc_init_se (&se, NULL); gfc_conv_expr_lhs (&se, code->expr); tmp = convert (TREE_TYPE (se.expr), stat); ! gfc_add_modify (&block, se.expr, tmp); } return gfc_finish_block (&block); *************** gfc_trans_deallocate (gfc_code * code) *** 3931,3937 **** apstat = build_fold_addr_expr (astat); /* Initialize astat to 0. */ ! gfc_add_modify_expr (&block, astat, build_int_cst (TREE_TYPE (astat), 0)); } else pstat = apstat = stat = astat = NULL_TREE; --- 4006,4012 ---- apstat = build_fold_addr_expr (astat); /* Initialize astat to 0. */ ! gfc_add_modify (&block, astat, build_int_cst (TREE_TYPE (astat), 0)); } else pstat = apstat = stat = astat = NULL_TREE; *************** gfc_trans_deallocate (gfc_code * code) *** 3959,3982 **** /* Do not deallocate the components of a derived type ultimate pointer component. */ ! if (!(last && last->u.c.component->pointer) && !(!last && expr->symtree->n.sym->attr.pointer)) { tmp = gfc_deallocate_alloc_comp (expr->ts.derived, se.expr, ! expr->rank); gfc_add_expr_to_block (&se.pre, tmp); } } if (expr->rank) ! tmp = gfc_array_deallocate (se.expr, pstat); else { ! tmp = gfc_deallocate_with_status (se.expr, pstat, false); gfc_add_expr_to_block (&se.pre, tmp); ! tmp = build2 (MODIFY_EXPR, void_type_node, ! se.expr, build_int_cst (TREE_TYPE (se.expr), 0)); } gfc_add_expr_to_block (&se.pre, tmp); --- 4034,4057 ---- /* Do not deallocate the components of a derived type ultimate pointer component. */ ! if (!(last && last->u.c.component->attr.pointer) && !(!last && expr->symtree->n.sym->attr.pointer)) { tmp = gfc_deallocate_alloc_comp (expr->ts.derived, se.expr, ! expr->rank); gfc_add_expr_to_block (&se.pre, tmp); } } if (expr->rank) ! tmp = gfc_array_deallocate (se.expr, pstat, expr); else { ! tmp = gfc_deallocate_with_status (se.expr, pstat, false, expr); gfc_add_expr_to_block (&se.pre, tmp); ! tmp = fold_build2 (MODIFY_EXPR, void_type_node, ! se.expr, build_int_cst (TREE_TYPE (se.expr), 0)); } gfc_add_expr_to_block (&se.pre, tmp); *************** gfc_trans_deallocate (gfc_code * code) *** 3985,3992 **** of the last deallocation to the running total. */ if (code->expr) { ! apstat = build2 (PLUS_EXPR, TREE_TYPE (stat), astat, stat); ! gfc_add_modify_expr (&se.pre, astat, apstat); } tmp = gfc_finish_block (&se.pre); --- 4060,4067 ---- of the last deallocation to the running total. */ if (code->expr) { ! apstat = fold_build2 (PLUS_EXPR, TREE_TYPE (stat), astat, stat); ! gfc_add_modify (&se.pre, astat, apstat); } tmp = gfc_finish_block (&se.pre); *************** gfc_trans_deallocate (gfc_code * code) *** 4000,4006 **** gfc_init_se (&se, NULL); gfc_conv_expr_lhs (&se, code->expr); tmp = convert (TREE_TYPE (se.expr), astat); ! gfc_add_modify_expr (&block, se.expr, tmp); } return gfc_finish_block (&block); --- 4075,4081 ---- gfc_init_se (&se, NULL); gfc_conv_expr_lhs (&se, code->expr); tmp = convert (TREE_TYPE (se.expr), astat); ! gfc_add_modify (&block, se.expr, tmp); } return gfc_finish_block (&block); diff -Nrcpad gcc-4.3.3/gcc/fortran/trans-stmt.h gcc-4.4.0/gcc/fortran/trans-stmt.h *** gcc-4.3.3/gcc/fortran/trans-stmt.h Wed Aug 1 16:29:36 2007 --- gcc-4.4.0/gcc/fortran/trans-stmt.h Sat Apr 5 22:23:27 2008 *************** *** 1,5 **** /* Header for statement translation functions ! Copyright (C) 2002, 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. --- 1,6 ---- /* Header for statement translation functions ! Copyright (C) 2002, 2003, 2006, 2007, 2008 ! Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. *************** tree gfc_trans_flush (gfc_code *); *** 68,70 **** --- 69,72 ---- tree gfc_trans_transfer (gfc_code *); tree gfc_trans_dt_end (gfc_code *); + tree gfc_trans_wait (gfc_code *); diff -Nrcpad gcc-4.3.3/gcc/fortran/trans-types.c gcc-4.4.0/gcc/fortran/trans-types.c *** gcc-4.3.3/gcc/fortran/trans-types.c Tue Jan 8 21:21:29 2008 --- gcc-4.4.0/gcc/fortran/trans-types.c Mon Mar 30 14:53:17 2009 *************** *** 1,6 **** /* Backend support for Fortran 95 basic types and derived types. ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software ! Foundation, Inc. Contributed by Paul Brook and Steven Bosscher --- 1,6 ---- /* Backend support for Fortran 95 basic types and derived types. ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 ! Free Software Foundation, Inc. Contributed by Paul Brook and Steven Bosscher *************** gfc_real_info gfc_real_kinds[MAX_REAL_KI *** 83,88 **** --- 83,93 ---- static GTY(()) tree gfc_real_types[MAX_REAL_KINDS + 1]; static GTY(()) tree gfc_complex_types[MAX_REAL_KINDS + 1]; + #define MAX_CHARACTER_KINDS 2 + gfc_character_info gfc_character_kinds[MAX_CHARACTER_KINDS + 1]; + static GTY(()) tree gfc_character_types[MAX_CHARACTER_KINDS + 1]; + static GTY(()) tree gfc_pcharacter_types[MAX_CHARACTER_KINDS + 1]; + /* The integer kind to use for array indices. This will be set to the proper value based on target information from the backend. */ *************** int gfc_numeric_storage_size; *** 112,132 **** int gfc_character_storage_size; ! /* Validate that the f90_type of the given gfc_typespec is valid for ! the type it represents. The f90_type represents the Fortran types ! this C kind can be used with. For example, c_int has a f90_type of ! BT_INTEGER and c_float has a f90_type of BT_REAL. Returns FAILURE ! if a mismatch occurs between ts->f90_type and ts->type; SUCCESS if ! they match. */ ! ! try ! gfc_validate_c_kind (gfc_typespec *ts) ! { ! return ((ts->type == ts->f90_type) ? SUCCESS : FAILURE); ! } ! ! ! try gfc_check_any_c_kind (gfc_typespec *ts) { int i; --- 117,123 ---- int gfc_character_storage_size; ! gfc_try gfc_check_any_c_kind (gfc_typespec *ts) { int i; *************** void init_c_interop_kinds (void) *** 219,225 **** c_interop_kinds_table[i].f90_type = BT_UNKNOWN; } ! #define NAMED_INTCST(a,b,c) \ strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \ c_interop_kinds_table[a].f90_type = BT_INTEGER; \ c_interop_kinds_table[a].value = c; --- 210,216 ---- c_interop_kinds_table[i].f90_type = BT_UNKNOWN; } ! #define NAMED_INTCST(a,b,c,d) \ strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \ c_interop_kinds_table[a].f90_type = BT_INTEGER; \ c_interop_kinds_table[a].value = c; *************** void *** 262,268 **** gfc_init_kinds (void) { enum machine_mode mode; ! int i_index, r_index; bool saw_i4 = false, saw_i8 = false; bool saw_r4 = false, saw_r8 = false, saw_r16 = false; --- 253,259 ---- gfc_init_kinds (void) { enum machine_mode mode; ! int i_index, r_index, kind; bool saw_i4 = false, saw_i8 = false; bool saw_r4 = false, saw_r8 = false, saw_r16 = false; *************** gfc_init_kinds (void) *** 356,362 **** if (kind == 16) saw_r16 = true; ! /* Careful we don't stumble a wierd internal mode. */ gcc_assert (r_index <= 0 || gfc_real_kinds[r_index-1].kind != kind); /* Or have too many modes for the allocated space. */ gcc_assert (r_index != MAX_REAL_KINDS); --- 347,353 ---- if (kind == 16) saw_r16 = true; ! /* Careful we don't stumble a weird internal mode. */ gcc_assert (r_index <= 0 || gfc_real_kinds[r_index-1].kind != kind); /* Or have too many modes for the allocated space. */ gcc_assert (r_index != MAX_REAL_KINDS); *************** gfc_init_kinds (void) *** 388,394 **** gfc_default_integer_kind = 8; /* Even if the user specified that the default integer kind be 8, ! the numerica storage size isn't 64. In this case, a warning will be issued when NUMERIC_STORAGE_SIZE is used. */ gfc_numeric_storage_size = 4 * 8; } --- 379,385 ---- gfc_default_integer_kind = 8; /* Even if the user specified that the default integer kind be 8, ! the numeric storage size isn't 64. In this case, a warning will be issued when NUMERIC_STORAGE_SIZE is used. */ gfc_numeric_storage_size = 4 * 8; } *************** gfc_init_kinds (void) *** 450,457 **** gfc_default_logical_kind = gfc_default_integer_kind; gfc_default_complex_kind = gfc_default_real_kind; /* Choose the smallest integer kind for our default character. */ ! gfc_default_character_kind = gfc_integer_kinds[0].kind; gfc_character_storage_size = gfc_default_character_kind * 8; /* Choose the integer kind the same size as "void*" for our index kind. */ --- 441,467 ---- gfc_default_logical_kind = gfc_default_integer_kind; gfc_default_complex_kind = gfc_default_real_kind; + /* We only have two character kinds: ASCII and UCS-4. + ASCII corresponds to a 8-bit integer type, if one is available. + UCS-4 corresponds to a 32-bit integer type, if one is available. */ + i_index = 0; + if ((kind = get_int_kind_from_width (8)) > 0) + { + gfc_character_kinds[i_index].kind = kind; + gfc_character_kinds[i_index].bit_size = 8; + gfc_character_kinds[i_index].name = "ascii"; + i_index++; + } + if ((kind = get_int_kind_from_width (32)) > 0) + { + gfc_character_kinds[i_index].kind = kind; + gfc_character_kinds[i_index].bit_size = 32; + gfc_character_kinds[i_index].name = "iso_10646"; + i_index++; + } + /* Choose the smallest integer kind for our default character. */ ! gfc_default_character_kind = gfc_character_kinds[0].kind; gfc_character_storage_size = gfc_default_character_kind * 8; /* Choose the integer kind the same size as "void*" for our index kind. */ *************** validate_logical (int kind) *** 505,511 **** static int validate_character (int kind) { ! return kind == gfc_default_character_kind ? 0 : -1; } /* Validate a kind given a basic type. The return value is the same --- 515,527 ---- static int validate_character (int kind) { ! int i; ! ! for (i = 0; gfc_character_kinds[i].kind; i++) ! if (gfc_character_kinds[i].kind == kind) ! return i; ! ! return -1; } /* Validate a kind given a basic type. The return value is the same *************** gfc_build_int_type (gfc_integer_info *in *** 580,585 **** --- 596,619 ---- } static tree + gfc_build_uint_type (int size) + { + if (size == CHAR_TYPE_SIZE) + return unsigned_char_type_node; + if (size == SHORT_TYPE_SIZE) + return short_unsigned_type_node; + if (size == INT_TYPE_SIZE) + return unsigned_type_node; + if (size == LONG_TYPE_SIZE) + return long_unsigned_type_node; + if (size == LONG_LONG_TYPE_SIZE) + return long_long_unsigned_type_node; + + return make_unsigned_type (size); + } + + + static tree gfc_build_real_type (gfc_real_info *info) { int mode_precision = info->mode_precision; *************** gfc_init_types (void) *** 717,725 **** PUSH_TYPE (name_buf, type); } ! gfc_character1_type_node = build_qualified_type (unsigned_char_type_node, ! TYPE_UNQUALIFIED); ! PUSH_TYPE ("character(kind=1)", gfc_character1_type_node); PUSH_TYPE ("byte", unsigned_char_type_node); PUSH_TYPE ("void", void_type_node); --- 751,767 ---- PUSH_TYPE (name_buf, type); } ! for (index = 0; gfc_character_kinds[index].kind != 0; ++index) ! { ! type = gfc_build_uint_type (gfc_character_kinds[index].bit_size); ! type = build_qualified_type (type, TYPE_UNQUALIFIED); ! snprintf (name_buf, sizeof(name_buf), "character(kind=%d)", ! gfc_character_kinds[index].kind); ! PUSH_TYPE (name_buf, type); ! gfc_character_types[index] = type; ! gfc_pcharacter_types[index] = build_pointer_type (type); ! } ! gfc_character1_type_node = gfc_character_types[0]; PUSH_TYPE ("byte", unsigned_char_type_node); PUSH_TYPE ("void", void_type_node); *************** gfc_get_logical_type (int kind) *** 799,821 **** int index = gfc_validate_kind (BT_LOGICAL, kind, true); return index < 0 ? 0 : gfc_logical_types[index]; } /* Create a character type with the given kind and length. */ tree ! gfc_get_character_type_len (int kind, tree len) { tree bounds, type; - gfc_validate_kind (BT_CHARACTER, kind, false); - bounds = build_range_type (gfc_charlen_type_node, gfc_index_one_node, len); ! type = build_array_type (gfc_character1_type_node, bounds); TYPE_STRING_FLAG (type) = 1; return type; } /* Get a type node for a character kind. */ --- 841,883 ---- int index = gfc_validate_kind (BT_LOGICAL, kind, true); return index < 0 ? 0 : gfc_logical_types[index]; } + + tree + gfc_get_char_type (int kind) + { + int index = gfc_validate_kind (BT_CHARACTER, kind, true); + return index < 0 ? 0 : gfc_character_types[index]; + } + + tree + gfc_get_pchar_type (int kind) + { + int index = gfc_validate_kind (BT_CHARACTER, kind, true); + return index < 0 ? 0 : gfc_pcharacter_types[index]; + } + /* Create a character type with the given kind and length. */ tree ! gfc_get_character_type_len_for_eltype (tree eltype, tree len) { tree bounds, type; bounds = build_range_type (gfc_charlen_type_node, gfc_index_one_node, len); ! type = build_array_type (eltype, bounds); TYPE_STRING_FLAG (type) = 1; return type; } + tree + gfc_get_character_type_len (int kind, tree len) + { + gfc_validate_kind (BT_CHARACTER, kind, false); + return gfc_get_character_type_len_for_eltype (gfc_get_char_type (kind), len); + } + /* Get a type node for a character kind. */ *************** gfc_get_element_type (tree type) *** 989,996 **** ARRAYS comment. The data component points to the first element in the array. The ! offset field is the position of the origin of the array (ie element ! (0, 0 ...)). This may be outsite the bounds of the array. An element is accessed by data[offset + index0*stride0 + index1*stride1 + index2*stride2] --- 1051,1058 ---- ARRAYS comment. The data component points to the first element in the array. The ! offset field is the position of the origin of the array (i.e. element ! (0, 0 ...)). This may be outside the bounds of the array. An element is accessed by data[offset + index0*stride0 + index1*stride1 + index2*stride2] *************** gfc_get_element_type (tree type) *** 1002,1008 **** elements of the origin (2^63 on 64-bit machines). For example integer, dimension (80000:90000, 80000:90000, 2) :: array may not work properly on 32-bit machines because 80000*80000 > ! 2^31, so the calculation for stride02 would overflow. This may still work, but I haven't checked, and it relies on the overflow doing the right thing. --- 1064,1070 ---- elements of the origin (2^63 on 64-bit machines). For example integer, dimension (80000:90000, 80000:90000, 2) :: array may not work properly on 32-bit machines because 80000*80000 > ! 2^31, so the calculation for stride2 would overflow. This may still work, but I haven't checked, and it relies on the overflow doing the right thing. *************** gfc_get_nodesc_array_type (tree etype, g *** 1339,1348 **** mpz_clear (stride); mpz_clear (delta); ! /* In debug info represent packed arrays as multi-dimensional ! if they have rank > 1 and with proper bounds, instead of flat ! arrays. */ ! if (known_offset && write_symbols != NO_DEBUG) { tree gtype = etype, rtype, type_decl; --- 1401,1410 ---- mpz_clear (stride); mpz_clear (delta); ! /* Represent packed arrays as multi-dimensional if they have rank > ! 1 and with proper bounds, instead of flat arrays. This makes for ! better debug info. */ ! if (known_offset) { tree gtype = etype, rtype, type_decl; *************** gfc_get_array_type_bounds (tree etype, i *** 1437,1443 **** { char name[8 + GFC_RANK_DIGITS + GFC_MAX_SYMBOL_LEN]; tree fat_type, base_type, arraytype, lower, upper, stride, tmp, rtype; ! const char *typename; int n; base_type = gfc_get_array_descriptor_base (dimen); --- 1499,1505 ---- { char name[8 + GFC_RANK_DIGITS + GFC_MAX_SYMBOL_LEN]; tree fat_type, base_type, arraytype, lower, upper, stride, tmp, rtype; ! const char *type_name; int n; base_type = gfc_get_array_descriptor_base (dimen); *************** gfc_get_array_type_bounds (tree etype, i *** 1447,1457 **** if (tmp && TREE_CODE (tmp) == TYPE_DECL) tmp = DECL_NAME (tmp); if (tmp) ! typename = IDENTIFIER_POINTER (tmp); else ! typename = "unknown"; sprintf (name, "array" GFC_RANK_PRINTF_FORMAT "_%.*s", dimen, ! GFC_MAX_SYMBOL_LEN, typename); TYPE_NAME (fat_type) = get_identifier (name); GFC_DESCRIPTOR_TYPE_P (fat_type) = 1; --- 1509,1519 ---- if (tmp && TREE_CODE (tmp) == TYPE_DECL) tmp = DECL_NAME (tmp); if (tmp) ! type_name = IDENTIFIER_POINTER (tmp); else ! type_name = "unknown"; sprintf (name, "array" GFC_RANK_PRINTF_FORMAT "_%.*s", dimen, ! GFC_MAX_SYMBOL_LEN, type_name); TYPE_NAME (fat_type) = get_identifier (name); GFC_DESCRIPTOR_TYPE_P (fat_type) = 1; *************** gfc_sym_type (gfc_symbol * sym) *** 1551,1556 **** --- 1613,1628 ---- tree type; int byref; + /* Procedure Pointers inside COMMON blocks or as function result. */ + if (sym->attr.proc_pointer && (sym->attr.in_common || sym->attr.result)) + { + /* Unset proc_pointer as gfc_get_function_type calls gfc_sym_type. */ + sym->attr.proc_pointer = 0; + type = build_pointer_type (gfc_get_function_type (sym)); + sym->attr.proc_pointer = 1; + return type; + } + if (sym->attr.flavor == FL_PROCEDURE && !sym->attr.function) return void_type_node; *************** gfc_sym_type (gfc_symbol * sym) *** 1560,1567 **** if (sym->backend_decl && !sym->attr.function) return TREE_TYPE (sym->backend_decl); ! if (sym->ts.type == BT_CHARACTER && sym->attr.is_bind_c ! && (sym->attr.function || sym->attr.result)) type = gfc_character1_type_node; else type = gfc_typenode_for_spec (&sym->ts); --- 1632,1642 ---- if (sym->backend_decl && !sym->attr.function) return TREE_TYPE (sym->backend_decl); ! if (sym->ts.type == BT_CHARACTER ! && ((sym->attr.function && sym->attr.is_bind_c) ! || (sym->attr.result ! && sym->ns->proc_name ! && sym->ns->proc_name->attr.is_bind_c))) type = gfc_character1_type_node; else type = gfc_typenode_for_spec (&sym->ts); *************** copy_dt_decls_ifequal (gfc_symbol *from, *** 1688,1694 **** for (; to_cm; to_cm = to_cm->next, from_cm = from_cm->next) { to_cm->backend_decl = from_cm->backend_decl; ! if (!from_cm->pointer && from_cm->ts.type == BT_DERIVED) gfc_get_derived_type (to_cm->ts.derived); else if (from_cm->ts.type == BT_CHARACTER) --- 1763,1769 ---- for (; to_cm; to_cm = to_cm->next, from_cm = from_cm->next) { to_cm->backend_decl = from_cm->backend_decl; ! if (!from_cm->attr.pointer && from_cm->ts.type == BT_DERIVED) gfc_get_derived_type (to_cm->ts.derived); else if (from_cm->ts.type == BT_CHARACTER) *************** gfc_get_derived_type (gfc_symbol * deriv *** 1772,1778 **** if (c->ts.type != BT_DERIVED) continue; ! if (!c->pointer || c->ts.derived->backend_decl == NULL) c->ts.derived->backend_decl = gfc_get_derived_type (c->ts.derived); if (c->ts.derived && c->ts.derived->attr.is_iso_c) --- 1847,1853 ---- if (c->ts.type != BT_DERIVED) continue; ! if (!c->attr.pointer || c->ts.derived->backend_decl == NULL) c->ts.derived->backend_decl = gfc_get_derived_type (c->ts.derived); if (c->ts.derived && c->ts.derived->attr.is_iso_c) *************** gfc_get_derived_type (gfc_symbol * deriv *** 1817,1828 **** /* This returns an array descriptor type. Initialization may be required. */ ! if (c->dimension) { ! if (c->pointer || c->allocatable) { enum gfc_array_kind akind; ! if (c->pointer) akind = GFC_ARRAY_POINTER; else akind = GFC_ARRAY_ALLOCATABLE; --- 1892,1903 ---- /* This returns an array descriptor type. Initialization may be required. */ ! if (c->attr.dimension) { ! if (c->attr.pointer || c->attr.allocatable) { enum gfc_array_kind akind; ! if (c->attr.pointer) akind = GFC_ARRAY_POINTER; else akind = GFC_ARRAY_ALLOCATABLE; *************** gfc_get_derived_type (gfc_symbol * deriv *** 1834,1840 **** field_type = gfc_get_nodesc_array_type (field_type, c->as, PACKED_STATIC); } ! else if (c->pointer) field_type = build_pointer_type (field_type); field = gfc_add_field_to_struct (&fieldlist, typenode, --- 1909,1915 ---- field_type = gfc_get_nodesc_array_type (field_type, c->as, PACKED_STATIC); } ! else if (c->attr.pointer) field_type = build_pointer_type (field_type); field = gfc_add_field_to_struct (&fieldlist, typenode, *************** gfc_get_derived_type (gfc_symbol * deriv *** 1858,1869 **** gfc_finish_type (typenode); gfc_set_decl_location (TYPE_STUB_DECL (typenode), &derived->declared_at); derived->backend_decl = typenode; ! /* Add this backend_decl to all the other, equal derived types. */ ! for (dt = gfc_derived_types; dt; dt = dt->next) ! copy_dt_decls_ifequal (derived, dt->derived); return derived->backend_decl; } --- 1933,1956 ---- gfc_finish_type (typenode); gfc_set_decl_location (TYPE_STUB_DECL (typenode), &derived->declared_at); + if (derived->module && derived->ns->proc_name + && derived->ns->proc_name->attr.flavor == FL_MODULE) + { + if (derived->ns->proc_name->backend_decl + && TREE_CODE (derived->ns->proc_name->backend_decl) + == NAMESPACE_DECL) + { + TYPE_CONTEXT (typenode) = derived->ns->proc_name->backend_decl; + DECL_CONTEXT (TYPE_STUB_DECL (typenode)) + = derived->ns->proc_name->backend_decl; + } + } derived->backend_decl = typenode; ! /* Add this backend_decl to all the other, equal derived types. */ ! for (dt = gfc_derived_types; dt; dt = dt->next) ! copy_dt_decls_ifequal (derived, dt->derived); return derived->backend_decl; } *************** gfc_return_by_reference (gfc_symbol * sy *** 1878,1884 **** if (sym->attr.dimension) return 1; ! if (sym->ts.type == BT_CHARACTER && !sym->attr.is_bind_c) return 1; /* Possibly return complex numbers by reference for g77 compatibility. --- 1965,1975 ---- if (sym->attr.dimension) return 1; ! if (sym->ts.type == BT_CHARACTER ! && !sym->attr.is_bind_c ! && (!sym->attr.result ! || !sym->ns->proc_name ! || !sym->ns->proc_name->attr.is_bind_c)) return 1; /* Possibly return complex numbers by reference for g77 compatibility. *************** gfc_get_function_type (gfc_symbol * sym) *** 2060,2065 **** --- 2151,2159 ---- type = gfc_typenode_for_spec (&sym->ts); sym->ts.kind = gfc_default_real_kind; } + else if (sym->result && sym->result->attr.proc_pointer) + /* Procedure pointer return values. */ + type = gfc_sym_type (sym->result); else type = gfc_sym_type (sym); *************** gfc_type_for_size (unsigned bits, int un *** 2087,2093 **** } /* Handle TImode as a special case because it is used by some backends ! (eg. ARM) even though it is not available for normal use. */ #if HOST_BITS_PER_WIDE_INT >= 64 if (bits == TYPE_PRECISION (intTI_type_node)) return intTI_type_node; --- 2181,2187 ---- } /* Handle TImode as a special case because it is used by some backends ! (e.g. ARM) even though it is not available for normal use. */ #if HOST_BITS_PER_WIDE_INT >= 64 if (bits == TYPE_PRECISION (intTI_type_node)) return intTI_type_node; *************** gfc_get_array_descr_info (const_tree typ *** 2202,2208 **** else info->base_decl = base_decl = build_decl (VAR_DECL, NULL_TREE, ptype); ! elem_size = fold_convert (gfc_array_index_type, TYPE_SIZE_UNIT (etype)); field = TYPE_FIELDS (TYPE_MAIN_VARIANT (type)); data_off = byte_position (field); field = TREE_CHAIN (field); --- 2296,2305 ---- else info->base_decl = base_decl = build_decl (VAR_DECL, NULL_TREE, ptype); ! if (GFC_TYPE_ARRAY_SPAN (type)) ! elem_size = GFC_TYPE_ARRAY_SPAN (type); ! else ! elem_size = fold_convert (gfc_array_index_type, TYPE_SIZE_UNIT (etype)); field = TYPE_FIELDS (TYPE_MAIN_VARIANT (type)); data_off = byte_position (field); field = TREE_CHAIN (field); diff -Nrcpad gcc-4.3.3/gcc/fortran/trans-types.h gcc-4.4.0/gcc/fortran/trans-types.h *** gcc-4.3.3/gcc/fortran/trans-types.h Sun Dec 9 17:08:06 2007 --- gcc-4.4.0/gcc/fortran/trans-types.h Sun May 18 22:45:05 2008 *************** *** 1,6 **** /* Header for Fortran 95 types backend support. ! Copyright (C) 2002, 2003, 2004, 2005, 2007 Free Software Foundation, ! Inc. Contributed by Paul Brook and Steven Bosscher --- 1,6 ---- /* Header for Fortran 95 types backend support. ! Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008 ! Free Software Foundation, Inc. Contributed by Paul Brook and Steven Bosscher *************** tree gfc_get_int_type (int); *** 55,62 **** --- 55,65 ---- tree gfc_get_real_type (int); tree gfc_get_complex_type (int); tree gfc_get_logical_type (int); + tree gfc_get_char_type (int); + tree gfc_get_pchar_type (int); tree gfc_get_character_type (int, gfc_charlen *); 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 *); diff -Nrcpad gcc-4.3.3/gcc/fortran/trans.c gcc-4.4.0/gcc/fortran/trans.c *** gcc-4.3.3/gcc/fortran/trans.c Sat Nov 10 18:02:18 2007 --- gcc-4.4.0/gcc/fortran/trans.c Sat Nov 1 13:26:19 2008 *************** *** 1,5 **** /* Code translation -- generate GCC trees from gfc_code. ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook --- 1,5 ---- /* Code translation -- generate GCC trees from gfc_code. ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Paul Brook *************** along with GCC; see the file COPYING3. *** 23,29 **** #include "system.h" #include "coretypes.h" #include "tree.h" ! #include "tree-gimple.h" #include "ggc.h" #include "toplev.h" #include "defaults.h" --- 23,30 ---- #include "system.h" #include "coretypes.h" #include "tree.h" ! #include "gimple.h" ! #include "tree-iterator.h" #include "ggc.h" #include "toplev.h" #include "defaults.h" *************** gfc_create_var (tree type, const char *p *** 129,135 **** } ! /* If the an expression is not constant, evaluate it now. We assign the result of the expression to an artificially created variable VAR, and return a pointer to the VAR_DECL node for this variable. */ --- 130,136 ---- } ! /* If the expression is not constant, evaluate it now. We assign the result of the expression to an artificially created variable VAR, and return a pointer to the VAR_DECL node for this variable. */ *************** gfc_evaluate_now (tree expr, stmtblock_t *** 142,160 **** return expr; var = gfc_create_var (TREE_TYPE (expr), NULL); ! gfc_add_modify_expr (pblock, var, expr); return var; } ! /* Build a MODIFY_EXPR (or GIMPLE_MODIFY_STMT) node and add it to a ! given statement block PBLOCK. A MODIFY_EXPR is an assignment: LHS <- RHS. */ void ! gfc_add_modify (stmtblock_t * pblock, tree lhs, tree rhs, ! bool tuples_p) { tree tmp; --- 143,160 ---- return expr; var = gfc_create_var (TREE_TYPE (expr), NULL); ! gfc_add_modify (pblock, var, expr); return var; } ! /* Build a MODIFY_EXPR node and add it to a given statement block PBLOCK. ! A MODIFY_EXPR is an assignment: LHS <- RHS. */ void ! gfc_add_modify (stmtblock_t * pblock, tree lhs, tree rhs) { tree tmp; *************** gfc_add_modify (stmtblock_t * pblock, tr *** 167,174 **** || AGGREGATE_TYPE_P (TREE_TYPE (lhs))); #endif ! tmp = fold_build2 (tuples_p ? GIMPLE_MODIFY_STMT : MODIFY_EXPR, ! void_type_node, lhs, rhs); gfc_add_expr_to_block (pblock, tmp); } --- 167,173 ---- || AGGREGATE_TYPE_P (TREE_TYPE (lhs))); #endif ! tmp = fold_build2 (MODIFY_EXPR, void_type_node, lhs, rhs); gfc_add_expr_to_block (pblock, tmp); } *************** gfc_build_addr_expr (tree type, tree t) *** 278,285 **** tree type_domain = TYPE_DOMAIN (base_type); if (type_domain && TYPE_MIN_VALUE (type_domain)) min_val = TYPE_MIN_VALUE (type_domain); ! t = build4 (ARRAY_REF, TREE_TYPE (type), t, min_val, ! NULL_TREE, NULL_TREE); natural_type = type; } else --- 277,284 ---- tree type_domain = TYPE_DOMAIN (base_type); if (type_domain && TYPE_MIN_VALUE (type_domain)) min_val = TYPE_MIN_VALUE (type_domain); ! t = fold (build4 (ARRAY_REF, TREE_TYPE (type), ! t, min_val, NULL_TREE, NULL_TREE)); natural_type = type; } else *************** gfc_build_addr_expr (tree type, tree t) *** 296,302 **** { if (DECL_P (t)) TREE_ADDRESSABLE (t) = 1; ! t = build1 (ADDR_EXPR, natural_type, t); } if (type && natural_type != type) --- 295,301 ---- { if (DECL_P (t)) TREE_ADDRESSABLE (t) = 1; ! t = fold_build1 (ADDR_EXPR, natural_type, t); } if (type && natural_type != type) *************** gfc_build_array_ref (tree base, tree off *** 348,362 **** } ! /* Generate a runtime error if COND is true. */ ! void ! gfc_trans_runtime_check (tree cond, stmtblock_t * pblock, locus * where, ! const char * msgid, ...) { va_list ap; stmtblock_t block; - tree body; tree tmp; tree arg, arg2; tree *argarray; --- 347,369 ---- } ! /* Generate a call to print a runtime error possibly including multiple ! arguments and a locus. */ ! tree ! gfc_trans_runtime_error (bool error, locus* where, const char* msgid, ...) { va_list ap; + + va_start (ap, msgid); + return gfc_trans_runtime_error_vararg (error, where, msgid, ap); + } + + tree + gfc_trans_runtime_error_vararg (bool error, locus* where, const char* msgid, + va_list ap) + { stmtblock_t block; tree tmp; tree arg, arg2; tree *argarray; *************** gfc_trans_runtime_check (tree cond, stmt *** 365,373 **** const char *p; int line, nargs, i; - if (integer_zerop (cond)) - return; - /* Compute the number of extra arguments from the format string. */ for (p = msgid, nargs = 0; *p; p++) if (*p == '%') --- 372,377 ---- *************** gfc_trans_runtime_check (tree cond, stmt *** 382,392 **** if (where) { - #ifdef USE_MAPPED_LOCATION line = LOCATION_LINE (where->lb->location); - #else - line = where->lb->linenum; - #endif asprintf (&message, "At line %d of file %s", line, where->lb->file->filename); } --- 386,392 ---- *************** gfc_trans_runtime_check (tree cond, stmt *** 394,425 **** asprintf (&message, "In file '%s', around line %d", gfc_source_file, input_line + 1); ! arg = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const(message)); gfc_free(message); asprintf (&message, "%s", _(msgid)); ! arg2 = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const(message)); gfc_free(message); /* Build the argument array. */ argarray = (tree *) alloca (sizeof (tree) * (nargs + 2)); argarray[0] = arg; argarray[1] = arg2; - va_start (ap, msgid); for (i = 0; i < nargs; i++) ! argarray[2+i] = va_arg (ap, tree); va_end (ap); ! /* Build the function call to runtime_error_at; because of the variable ! number of arguments, we can't use build_call_expr directly. */ ! fntype = TREE_TYPE (gfor_fndecl_runtime_error_at); tmp = fold_builtin_call_array (TREE_TYPE (fntype), ! build1 (ADDR_EXPR, ! build_pointer_type (fntype), ! gfor_fndecl_runtime_error_at), nargs + 2, argarray); gfc_add_expr_to_block (&block, tmp); body = gfc_finish_block (&block); if (integer_onep (cond)) --- 394,470 ---- asprintf (&message, "In file '%s', around line %d", gfc_source_file, input_line + 1); ! arg = gfc_build_addr_expr (pchar_type_node, ! gfc_build_localized_cstring_const (message)); gfc_free(message); asprintf (&message, "%s", _(msgid)); ! arg2 = gfc_build_addr_expr (pchar_type_node, ! gfc_build_localized_cstring_const (message)); gfc_free(message); /* Build the argument array. */ argarray = (tree *) alloca (sizeof (tree) * (nargs + 2)); argarray[0] = arg; argarray[1] = arg2; for (i = 0; i < nargs; i++) ! argarray[2 + i] = va_arg (ap, tree); va_end (ap); ! /* Build the function call to runtime_(warning,error)_at; because of the ! variable number of arguments, we can't use build_call_expr directly. */ ! if (error) ! fntype = TREE_TYPE (gfor_fndecl_runtime_error_at); ! else ! fntype = TREE_TYPE (gfor_fndecl_runtime_warning_at); ! tmp = fold_builtin_call_array (TREE_TYPE (fntype), ! fold_build1 (ADDR_EXPR, ! build_pointer_type (fntype), ! error ! ? gfor_fndecl_runtime_error_at ! : gfor_fndecl_runtime_warning_at), nargs + 2, argarray); gfc_add_expr_to_block (&block, tmp); + return gfc_finish_block (&block); + } + + + /* Generate a runtime error if COND is true. */ + + void + gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock, + locus * where, const char * msgid, ...) + { + va_list ap; + stmtblock_t block; + tree body; + tree tmp; + tree tmpvar = NULL; + + if (integer_zerop (cond)) + return; + + if (once) + { + tmpvar = gfc_create_var (boolean_type_node, "print_warning"); + TREE_STATIC (tmpvar) = 1; + DECL_INITIAL (tmpvar) = boolean_true_node; + gfc_add_expr_to_block (pblock, tmpvar); + } + + gfc_start_block (&block); + + /* The code to generate the error. */ + va_start (ap, msgid); + gfc_add_expr_to_block (&block, + gfc_trans_runtime_error_vararg (error, where, + msgid, ap)); + + if (once) + gfc_add_modify (&block, tmpvar, boolean_false_node); + body = gfc_finish_block (&block); if (integer_onep (cond)) *************** gfc_trans_runtime_check (tree cond, stmt *** 429,435 **** else { /* Tell the compiler that this isn't likely. */ ! cond = fold_convert (long_integer_type_node, cond); tmp = build_int_cst (long_integer_type_node, 0); cond = build_call_expr (built_in_decls[BUILT_IN_EXPECT], 2, cond, tmp); cond = fold_convert (boolean_type_node, cond); --- 474,485 ---- else { /* Tell the compiler that this isn't likely. */ ! if (once) ! cond = fold_build2 (TRUTH_AND_EXPR, long_integer_type_node, tmpvar, ! cond); ! else ! cond = fold_convert (long_integer_type_node, cond); ! tmp = build_int_cst (long_integer_type_node, 0); cond = build_call_expr (built_in_decls[BUILT_IN_EXPECT], 2, cond, tmp); cond = fold_convert (boolean_type_node, cond); *************** gfc_trans_runtime_check (tree cond, stmt *** 442,453 **** /* Call malloc to allocate size bytes of memory, with special conditions: + if size < 0, generate a runtime error, ! + if size == 0, return a NULL pointer, + if malloc returns NULL, issue a runtime error. */ tree gfc_call_malloc (stmtblock_t * block, tree type, tree size) { ! tree tmp, msg, negative, zero, malloc_result, null_result, res; stmtblock_t block2; size = gfc_evaluate_now (size, block); --- 492,503 ---- /* Call malloc to allocate size bytes of memory, with special conditions: + if size < 0, generate a runtime error, ! + if size == 0, return a malloced area of size 1, + if malloc returns NULL, issue a runtime error. */ tree gfc_call_malloc (stmtblock_t * block, tree type, tree size) { ! tree tmp, msg, negative, malloc_result, null_result, res; stmtblock_t block2; size = gfc_evaluate_now (size, block); *************** gfc_call_malloc (stmtblock_t * block, tr *** 461,467 **** /* size < 0 ? */ negative = fold_build2 (LT_EXPR, boolean_type_node, size, build_int_cst (size_type_node, 0)); ! msg = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const ("Attempt to allocate a negative amount of memory.")); tmp = fold_build3 (COND_EXPR, void_type_node, negative, build_call_expr (gfor_fndecl_runtime_error, 1, msg), --- 511,517 ---- /* size < 0 ? */ negative = fold_build2 (LT_EXPR, boolean_type_node, size, build_int_cst (size_type_node, 0)); ! msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const ("Attempt to allocate a negative amount of memory.")); tmp = fold_build3 (COND_EXPR, void_type_node, negative, build_call_expr (gfor_fndecl_runtime_error, 1, msg), *************** gfc_call_malloc (stmtblock_t * block, tr *** 470,481 **** /* Call malloc and check the result. */ gfc_start_block (&block2); ! gfc_add_modify_expr (&block2, res, build_call_expr (built_in_decls[BUILT_IN_MALLOC], 1, size)); null_result = fold_build2 (EQ_EXPR, boolean_type_node, res, build_int_cst (pvoid_type_node, 0)); ! msg = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const ("Memory allocation failed")); tmp = fold_build3 (COND_EXPR, void_type_node, null_result, build_call_expr (gfor_fndecl_os_error, 1, msg), --- 520,535 ---- /* Call malloc and check the result. */ gfc_start_block (&block2); ! ! size = fold_build2 (MAX_EXPR, size_type_node, size, ! build_int_cst (size_type_node, 1)); ! ! gfc_add_modify (&block2, res, build_call_expr (built_in_decls[BUILT_IN_MALLOC], 1, size)); null_result = fold_build2 (EQ_EXPR, boolean_type_node, res, build_int_cst (pvoid_type_node, 0)); ! msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const ("Memory allocation failed")); tmp = fold_build3 (COND_EXPR, void_type_node, null_result, build_call_expr (gfor_fndecl_os_error, 1, msg), *************** gfc_call_malloc (stmtblock_t * block, tr *** 483,495 **** gfc_add_expr_to_block (&block2, tmp); malloc_result = gfc_finish_block (&block2); ! /* size == 0 */ ! zero = fold_build2 (EQ_EXPR, boolean_type_node, size, ! build_int_cst (size_type_node, 0)); ! tmp = fold_build2 (MODIFY_EXPR, pvoid_type_node, res, ! build_int_cst (pvoid_type_node, 0)); ! tmp = fold_build3 (COND_EXPR, void_type_node, zero, tmp, malloc_result); ! gfc_add_expr_to_block (block, tmp); if (type != NULL) res = fold_convert (type, res); --- 537,543 ---- gfc_add_expr_to_block (&block2, tmp); malloc_result = gfc_finish_block (&block2); ! gfc_add_expr_to_block (block, malloc_result); if (type != NULL) res = fold_convert (type, res); *************** gfc_call_malloc (stmtblock_t * block, tr *** 506,535 **** void *newmem; if (stat) ! *stat = 0; // The only time this can happen is the size wraps around. if (size < 0) { ! if (stat) ! { ! *stat = LIBERROR_ALLOCATION; ! newmem = NULL; ! } ! else ! runtime_error ("Attempt to allocate negative amount of memory. " ! "Possible integer overflow"); } else { ! newmem = malloc (MAX (size, 1)); ! if (newmem == NULL) ! { ! if (stat) ! *stat = LIBERROR_ALLOCATION; ! else ! runtime_error ("Out of memory"); ! } } return newmem; --- 554,583 ---- void *newmem; if (stat) ! *stat = 0; // The only time this can happen is the size wraps around. if (size < 0) { ! if (stat) ! { ! *stat = LIBERROR_ALLOCATION; ! newmem = NULL; ! } ! else ! runtime_error ("Attempt to allocate negative amount of memory. " ! "Possible integer overflow"); } else { ! newmem = malloc (MAX (size, 1)); ! if (newmem == NULL) ! { ! if (stat) ! *stat = LIBERROR_ALLOCATION; ! else ! runtime_error ("Out of memory"); ! } } return newmem; *************** gfc_allocate_with_status (stmtblock_t * *** 553,559 **** if (status != NULL_TREE && !integer_zerop (status)) { tmp = fold_build2 (MODIFY_EXPR, status_type, ! build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, 0)); tmp = fold_build3 (COND_EXPR, void_type_node, fold_build2 (NE_EXPR, boolean_type_node, --- 601,607 ---- if (status != NULL_TREE && !integer_zerop (status)) { tmp = fold_build2 (MODIFY_EXPR, status_type, ! fold_build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, 0)); tmp = fold_build3 (COND_EXPR, void_type_node, fold_build2 (NE_EXPR, boolean_type_node, *************** gfc_allocate_with_status (stmtblock_t * *** 563,569 **** } /* Generate the block of code handling (size < 0). */ ! msg = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const ("Attempt to allocate negative amount of memory. " "Possible integer overflow")); error = build_call_expr (gfor_fndecl_runtime_error, 1, msg); --- 611,617 ---- } /* Generate the block of code handling (size < 0). */ ! msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const ("Attempt to allocate negative amount of memory. " "Possible integer overflow")); error = build_call_expr (gfor_fndecl_runtime_error, 1, msg); *************** gfc_allocate_with_status (stmtblock_t * *** 574,583 **** stmtblock_t set_status_block; gfc_start_block (&set_status_block); ! gfc_add_modify_expr (&set_status_block, ! build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, LIBERROR_ALLOCATION)); ! gfc_add_modify_expr (&set_status_block, res, build_int_cst (pvoid_type_node, 0)); tmp = fold_build2 (EQ_EXPR, boolean_type_node, status, --- 622,631 ---- stmtblock_t set_status_block; gfc_start_block (&set_status_block); ! gfc_add_modify (&set_status_block, ! fold_build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, LIBERROR_ALLOCATION)); ! gfc_add_modify (&set_status_block, res, build_int_cst (pvoid_type_node, 0)); tmp = fold_build2 (EQ_EXPR, boolean_type_node, status, *************** gfc_allocate_with_status (stmtblock_t * *** 588,601 **** /* The allocation itself. */ gfc_start_block (&alloc_block); ! gfc_add_modify_expr (&alloc_block, res, build_call_expr (built_in_decls[BUILT_IN_MALLOC], 1, fold_build2 (MAX_EXPR, size_type_node, size, build_int_cst (size_type_node, 1)))); ! msg = gfc_build_addr_expr (pchar_type_node, ! gfc_build_cstring_const ("Out of memory")); tmp = build_call_expr (gfor_fndecl_os_error, 1, msg); if (status != NULL_TREE && !integer_zerop (status)) --- 636,649 ---- /* The allocation itself. */ gfc_start_block (&alloc_block); ! gfc_add_modify (&alloc_block, res, build_call_expr (built_in_decls[BUILT_IN_MALLOC], 1, fold_build2 (MAX_EXPR, size_type_node, size, build_int_cst (size_type_node, 1)))); ! msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const ! ("Out of memory")); tmp = build_call_expr (gfor_fndecl_os_error, 1, msg); if (status != NULL_TREE && !integer_zerop (status)) *************** gfc_allocate_with_status (stmtblock_t * *** 606,612 **** cond = fold_build2 (EQ_EXPR, boolean_type_node, status, build_int_cst (status_type, 0)); tmp2 = fold_build2 (MODIFY_EXPR, status_type, ! build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, LIBERROR_ALLOCATION)); tmp = fold_build3 (COND_EXPR, void_type_node, cond, tmp, tmp2); --- 654,660 ---- cond = fold_build2 (EQ_EXPR, boolean_type_node, status, build_int_cst (status_type, 0)); tmp2 = fold_build2 (MODIFY_EXPR, status_type, ! fold_build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, LIBERROR_ALLOCATION)); tmp = fold_build3 (COND_EXPR, void_type_node, cond, tmp, tmp2); *************** gfc_allocate_with_status (stmtblock_t * *** 650,662 **** } else runtime_error ("Attempting to allocate already allocated array"); ! } */ tree gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size, ! tree status) { stmtblock_t alloc_block; ! tree res, tmp, null_mem, alloc, error, msg; tree type = TREE_TYPE (mem); if (TREE_TYPE (size) != TREE_TYPE (size_type_node)) --- 698,713 ---- } else runtime_error ("Attempting to allocate already allocated array"); ! } ! ! 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. */ tree gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size, ! tree status, gfc_expr* expr) { stmtblock_t alloc_block; ! tree res, tmp, null_mem, alloc, error; tree type = TREE_TYPE (mem); if (TREE_TYPE (size) != TREE_TYPE (size_type_node)) *************** gfc_allocate_array_with_status (stmtbloc *** 670,682 **** /* If mem is NULL, we call gfc_allocate_with_status. */ gfc_start_block (&alloc_block); tmp = gfc_allocate_with_status (&alloc_block, size, status); ! gfc_add_modify_expr (&alloc_block, res, fold_convert (type, tmp)); alloc = gfc_finish_block (&alloc_block); /* Otherwise, we issue a runtime error or set the status variable. */ ! msg = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const ! ("Attempting to allocate already allocated array")); ! error = build_call_expr (gfor_fndecl_runtime_error, 1, msg); if (status != NULL_TREE && !integer_zerop (status)) { --- 721,747 ---- /* If mem is NULL, we call gfc_allocate_with_status. */ gfc_start_block (&alloc_block); tmp = gfc_allocate_with_status (&alloc_block, size, status); ! gfc_add_modify (&alloc_block, res, fold_convert (type, tmp)); alloc = gfc_finish_block (&alloc_block); /* Otherwise, we issue a runtime error or set the status variable. */ ! if (expr) ! { ! tree varname; ! ! gcc_assert (expr->expr_type == EXPR_VARIABLE && expr->symtree); ! varname = gfc_build_cstring_const (expr->symtree->name); ! varname = gfc_build_addr_expr (pchar_type_node, varname); ! ! error = gfc_trans_runtime_error (true, &expr->where, ! "Attempting to allocate already" ! " allocated array '%s'", ! varname); ! } ! else ! error = gfc_trans_runtime_error (true, NULL, ! "Attempting to allocate already allocated" ! "array"); if (status != NULL_TREE && !integer_zerop (status)) { *************** gfc_allocate_array_with_status (stmtbloc *** 689,698 **** gfc_add_expr_to_block (&set_status_block, tmp); tmp = gfc_allocate_with_status (&set_status_block, size, status); ! gfc_add_modify_expr (&set_status_block, res, fold_convert (type, tmp)); ! gfc_add_modify_expr (&set_status_block, ! build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, LIBERROR_ALLOCATION)); tmp = fold_build2 (EQ_EXPR, boolean_type_node, status, --- 754,763 ---- gfc_add_expr_to_block (&set_status_block, tmp); tmp = gfc_allocate_with_status (&set_status_block, size, status); ! gfc_add_modify (&set_status_block, res, fold_convert (type, tmp)); ! gfc_add_modify (&set_status_block, ! fold_build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, LIBERROR_ALLOCATION)); tmp = fold_build2 (EQ_EXPR, boolean_type_node, status, *************** gfc_call_free (tree var) *** 757,768 **** Moreover, if CAN_FAIL is true, then we will not emit a runtime error, even when no status variable is passed to us (this is used for unconditional deallocation generated by the front-end at end of ! each procedure). */ tree ! gfc_deallocate_with_status (tree pointer, tree status, bool can_fail) { stmtblock_t null, non_null; ! tree cond, tmp, error, msg; cond = fold_build2 (EQ_EXPR, boolean_type_node, pointer, build_int_cst (TREE_TYPE (pointer), 0)); --- 822,837 ---- Moreover, if CAN_FAIL is true, then we will not emit a runtime error, even when no status variable is passed to us (this is used for unconditional deallocation generated by the front-end at end of ! each procedure). ! ! If a runtime-message is possible, `expr' must point to the original ! expression being deallocated for its locus and variable name. */ tree ! gfc_deallocate_with_status (tree pointer, tree status, bool can_fail, ! gfc_expr* expr) { stmtblock_t null, non_null; ! tree cond, tmp, error; cond = fold_build2 (EQ_EXPR, boolean_type_node, pointer, build_int_cst (TREE_TYPE (pointer), 0)); *************** gfc_deallocate_with_status (tree pointer *** 772,780 **** gfc_start_block (&null); if (!can_fail) { ! msg = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const ! ("Attempt to DEALLOCATE unallocated memory.")); ! error = build_call_expr (gfor_fndecl_runtime_error, 1, msg); } else error = build_empty_stmt (); --- 841,856 ---- gfc_start_block (&null); if (!can_fail) { ! tree varname; ! ! gcc_assert (expr && expr->expr_type == EXPR_VARIABLE && expr->symtree); ! ! varname = gfc_build_cstring_const (expr->symtree->name); ! varname = gfc_build_addr_expr (pchar_type_node, varname); ! ! error = gfc_trans_runtime_error (true, &expr->where, ! "Attempt to DEALLOCATE unallocated '%s'", ! varname); } else error = build_empty_stmt (); *************** gfc_deallocate_with_status (tree pointer *** 787,793 **** cond2 = fold_build2 (NE_EXPR, boolean_type_node, status, build_int_cst (TREE_TYPE (status), 0)); tmp = fold_build2 (MODIFY_EXPR, status_type, ! build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, 1)); error = fold_build3 (COND_EXPR, void_type_node, cond2, tmp, error); } --- 863,869 ---- cond2 = fold_build2 (NE_EXPR, boolean_type_node, status, build_int_cst (TREE_TYPE (status), 0)); tmp = fold_build2 (MODIFY_EXPR, status_type, ! fold_build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, 1)); error = fold_build3 (COND_EXPR, void_type_node, cond2, tmp, error); } *************** gfc_deallocate_with_status (tree pointer *** 809,815 **** cond2 = fold_build2 (NE_EXPR, boolean_type_node, status, build_int_cst (TREE_TYPE (status), 0)); tmp = fold_build2 (MODIFY_EXPR, status_type, ! build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, 0)); tmp = fold_build3 (COND_EXPR, void_type_node, cond2, tmp, build_empty_stmt ()); --- 885,891 ---- cond2 = fold_build2 (NE_EXPR, boolean_type_node, status, build_int_cst (TREE_TYPE (status), 0)); tmp = fold_build2 (MODIFY_EXPR, status_type, ! fold_build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, 0)); tmp = fold_build3 (COND_EXPR, void_type_node, cond2, tmp, build_empty_stmt ()); *************** gfc_call_realloc (stmtblock_t * block, t *** 855,861 **** /* size < 0 ? */ negative = fold_build2 (LT_EXPR, boolean_type_node, size, build_int_cst (size_type_node, 0)); ! msg = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const ("Attempt to allocate a negative amount of memory.")); tmp = fold_build3 (COND_EXPR, void_type_node, negative, build_call_expr (gfor_fndecl_runtime_error, 1, msg), --- 931,937 ---- /* size < 0 ? */ negative = fold_build2 (LT_EXPR, boolean_type_node, size, build_int_cst (size_type_node, 0)); ! msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const ("Attempt to allocate a negative amount of memory.")); tmp = fold_build3 (COND_EXPR, void_type_node, negative, build_call_expr (gfor_fndecl_runtime_error, 1, msg), *************** gfc_call_realloc (stmtblock_t * block, t *** 865,879 **** /* Call realloc and check the result. */ tmp = build_call_expr (built_in_decls[BUILT_IN_REALLOC], 2, fold_convert (pvoid_type_node, mem), size); ! gfc_add_modify_expr (block, res, fold_convert (type, tmp)); null_result = fold_build2 (EQ_EXPR, boolean_type_node, res, build_int_cst (pvoid_type_node, 0)); nonzero = fold_build2 (NE_EXPR, boolean_type_node, size, build_int_cst (size_type_node, 0)); null_result = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, null_result, nonzero); ! msg = gfc_build_addr_expr (pchar_type_node, ! gfc_build_cstring_const ("Out of memory")); tmp = fold_build3 (COND_EXPR, void_type_node, null_result, build_call_expr (gfor_fndecl_os_error, 1, msg), build_empty_stmt ()); --- 941,955 ---- /* Call realloc and check the result. */ tmp = build_call_expr (built_in_decls[BUILT_IN_REALLOC], 2, fold_convert (pvoid_type_node, mem), size); ! gfc_add_modify (block, res, fold_convert (type, tmp)); null_result = fold_build2 (EQ_EXPR, boolean_type_node, res, build_int_cst (pvoid_type_node, 0)); nonzero = fold_build2 (NE_EXPR, boolean_type_node, size, build_int_cst (size_type_node, 0)); null_result = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, null_result, nonzero); ! msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const ! ("Out of memory")); tmp = fold_build3 (COND_EXPR, void_type_node, null_result, build_call_expr (gfor_fndecl_os_error, 1, msg), build_empty_stmt ()); *************** gfc_add_block_to_block (stmtblock_t * bl *** 936,947 **** void gfc_get_backend_locus (locus * loc) { ! loc->lb = gfc_getmem (sizeof (gfc_linebuf)); ! #ifdef USE_MAPPED_LOCATION loc->lb->location = input_location; - #else - loc->lb->linenum = input_line; - #endif loc->lb->file = gfc_current_backend_file; } --- 1012,1019 ---- void gfc_get_backend_locus (locus * loc) { ! loc->lb = XCNEW (gfc_linebuf); loc->lb->location = input_location; loc->lb->file = gfc_current_backend_file; } *************** void *** 952,963 **** gfc_set_backend_locus (locus * loc) { gfc_current_backend_file = loc->lb->file; - #ifdef USE_MAPPED_LOCATION input_location = loc->lb->location; - #else - input_line = loc->lb->linenum; - input_filename = loc->lb->file->filename; - #endif } --- 1024,1030 ---- *************** gfc_trans_code (gfc_code * code) *** 974,980 **** gfc_start_block (&block); ! /* Translate statements one by one to GIMPLE trees until we reach the end of this gfc_code branch. */ for (; code; code = code->next) { --- 1041,1047 ---- gfc_start_block (&block); ! /* Translate statements one by one into GENERIC trees until we reach the end of this gfc_code branch. */ for (; code; code = code->next) { *************** gfc_trans_code (gfc_code * code) *** 1035,1041 **** break; case EXEC_CALL: ! res = gfc_trans_call (code, false); break; case EXEC_ASSIGN_CALL: --- 1102,1116 ---- break; case EXEC_CALL: ! /* For MVBITS we've got the special exception that we need a ! dependency check, too. */ ! { ! bool is_mvbits = false; ! if (code->resolved_isym ! && code->resolved_isym->id == GFC_ISYM_MVBITS) ! is_mvbits = true; ! res = gfc_trans_call (code, is_mvbits); ! } break; case EXEC_ASSIGN_CALL: *************** gfc_trans_code (gfc_code * code) *** 1118,1123 **** --- 1193,1202 ---- res = gfc_trans_inquire (code); break; + case EXEC_WAIT: + res = gfc_trans_wait (code); + break; + case EXEC_REWIND: res = gfc_trans_rewind (code); break; *************** gfc_trans_code (gfc_code * code) *** 1143,1148 **** --- 1222,1229 ---- case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: + case EXEC_OMP_TASK: + case EXEC_OMP_TASKWAIT: case EXEC_OMP_WORKSHARE: res = gfc_trans_omp_directive (code); break; *************** gfc_trans_code (gfc_code * code) *** 1156,1162 **** if (res != NULL_TREE && ! IS_EMPTY_STMT (res)) { if (TREE_CODE (res) == STATEMENT_LIST) ! annotate_all_with_locus (&res, input_location); else SET_EXPR_LOCATION (res, input_location); --- 1237,1243 ---- if (res != NULL_TREE && ! IS_EMPTY_STMT (res)) { if (TREE_CODE (res) == STATEMENT_LIST) ! tree_annotate_all_with_location (&res, input_location); else SET_EXPR_LOCATION (res, input_location); *************** void *** 1193,1198 **** --- 1274,1292 ---- gfc_generate_module_code (gfc_namespace * ns) { gfc_namespace *n; + struct module_htab_entry *entry; + + gcc_assert (ns->proc_name->backend_decl == NULL); + ns->proc_name->backend_decl + = build_decl (NAMESPACE_DECL, get_identifier (ns->proc_name->name), + void_type_node); + gfc_set_decl_location (ns->proc_name->backend_decl, + &ns->proc_name->declared_at); + entry = gfc_find_module (ns->proc_name->name); + if (entry->namespace_decl) + /* Buggy sourcecode, using a module before defining it? */ + htab_empty (entry->decls); + entry->namespace_decl = ns->proc_name->backend_decl; gfc_generate_module_vars (ns); *************** gfc_generate_module_code (gfc_namespace *** 1200,1209 **** --- 1294,1314 ---- sibling calls. */ for (n = ns->contained; n; n = n->sibling) { + gfc_entry_list *el; + if (!n->proc_name) continue; gfc_create_function_decl (n); + gcc_assert (DECL_CONTEXT (n->proc_name->backend_decl) == NULL_TREE); + DECL_CONTEXT (n->proc_name->backend_decl) = ns->proc_name->backend_decl; + gfc_module_add_decl (entry, n->proc_name->backend_decl); + for (el = ns->entries; el; el = el->next) + { + gcc_assert (DECL_CONTEXT (el->sym->backend_decl) == NULL_TREE); + DECL_CONTEXT (el->sym->backend_decl) = ns->proc_name->backend_decl; + gfc_module_add_decl (entry, el->sym->backend_decl); + } } for (n = ns->contained; n; n = n->sibling) diff -Nrcpad gcc-4.3.3/gcc/fortran/trans.h gcc-4.4.0/gcc/fortran/trans.h *** gcc-4.3.3/gcc/fortran/trans.h Sat May 17 07:10:13 2008 --- gcc-4.4.0/gcc/fortran/trans.h Thu Dec 18 10:05:54 2008 *************** *** 1,5 **** /* Header for code translation functions ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook --- 1,5 ---- /* Header for code translation functions ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Paul Brook *************** typedef enum *** 137,143 **** /* A non-elemental function call returning an array. The call is executed before entering the scalarization loop, storing the result in a temporary. This temporary is then used inside the scalarization loop. ! Simple assignments, eg. a(:) = fn() are handles without a temporary as a special case. */ GFC_SS_FUNCTION, --- 137,143 ---- /* A non-elemental function call returning an array. The call is executed before entering the scalarization loop, storing the result in a temporary. This temporary is then used inside the scalarization loop. ! Simple assignments, e.g. a(:) = fn(), are handled without a temporary as a special case. */ GFC_SS_FUNCTION, *************** typedef struct gfc_ss *** 206,212 **** unsigned useflags:2, where:1; } gfc_ss; ! #define gfc_get_ss() gfc_getmem(sizeof(gfc_ss)) /* The contents of this aren't actually used. A NULL SS chain indicates a scalar expression, so this pointer is used to terminate SS chains. */ --- 206,212 ---- unsigned useflags:2, where:1; } gfc_ss; ! #define gfc_get_ss() XCNEW (gfc_ss) /* The contents of this aren't actually used. A NULL SS chain indicates a scalar expression, so this pointer is used to terminate SS chains. */ *************** void gfc_make_safe_expr (gfc_se * se); *** 278,284 **** void gfc_conv_string_parameter (gfc_se * se); /* Compare two strings. */ ! tree gfc_build_compare_string (tree, tree, tree, tree); /* Add an item to the end of TREE_LIST. */ tree gfc_chainon_list (tree, tree); --- 278,284 ---- void gfc_conv_string_parameter (gfc_se * se); /* Compare two strings. */ ! tree gfc_build_compare_string (tree, tree, tree, tree, int); /* Add an item to the end of TREE_LIST. */ tree gfc_chainon_list (tree, tree); *************** tree gfc_conv_string_tmp (gfc_se *, tree *** 340,346 **** /* Get the string length variable belonging to an expression. */ tree gfc_get_expr_charlen (gfc_expr *); /* Initialize a string length variable. */ ! void gfc_conv_string_length (gfc_charlen *, stmtblock_t *); /* Ensure type sizes can be gimplified. */ void gfc_trans_vla_type_sizes (gfc_symbol *, stmtblock_t *); --- 340,346 ---- /* Get the string length variable belonging to an expression. */ tree gfc_get_expr_charlen (gfc_expr *); /* Initialize a string length variable. */ ! void gfc_conv_string_length (gfc_charlen *, gfc_expr *, stmtblock_t *); /* Ensure type sizes can be gimplified. */ void gfc_trans_vla_type_sizes (gfc_symbol *, stmtblock_t *); *************** void gfc_trans_vla_type_sizes (gfc_symbo *** 348,359 **** void gfc_add_expr_to_block (stmtblock_t *, tree); /* Add a block to the end of a block. */ void gfc_add_block_to_block (stmtblock_t *, stmtblock_t *); ! /* Add a MODIFY_EXPR or a GIMPLE_MODIFY_STMT to a block. */ ! void gfc_add_modify (stmtblock_t *, tree, tree, bool); ! #define gfc_add_modify_expr(BLOCK, LHS, RHS) \ ! gfc_add_modify ((BLOCK), (LHS), (RHS), false) ! #define gfc_add_modify_stmt(BLOCK, LHS, RHS) \ ! gfc_add_modify ((BLOCK), (LHS), (RHS), true) /* Initialize a statement block. */ void gfc_init_block (stmtblock_t *); --- 348,355 ---- void gfc_add_expr_to_block (stmtblock_t *, tree); /* Add a block to the end of a block. */ void gfc_add_block_to_block (stmtblock_t *, stmtblock_t *); ! /* Add a MODIFY_EXPR to a block. */ ! void gfc_add_modify (stmtblock_t *, tree, tree); /* Initialize a statement block. */ void gfc_init_block (stmtblock_t *); *************** void gfc_generate_block_data (gfc_namesp *** 433,438 **** --- 429,444 ---- /* Output a decl for a module variable. */ void gfc_generate_module_vars (gfc_namespace *); + struct module_htab_entry GTY(()) + { + const char *name; + tree namespace_decl; + htab_t GTY ((param_is (union tree_node))) decls; + }; + + struct module_htab_entry *gfc_find_module (const char *); + void gfc_module_add_decl (struct module_htab_entry *, tree); + /* Get and set the current location. */ void gfc_set_backend_locus (locus *); void gfc_get_backend_locus (locus *); *************** void gfc_generate_constructors (void); *** 444,451 **** /* Get the string length of an array constructor. */ bool get_array_ctor_strlen (stmtblock_t *, gfc_constructor *, tree *); ! /* Generate a runtime error check. */ ! void gfc_trans_runtime_check (tree, stmtblock_t *, locus *, const char *, ...); /* Generate a call to free() after checking that its arg is non-NULL. */ tree gfc_call_free (tree); --- 450,466 ---- /* Get the string length of an array constructor. */ bool get_array_ctor_strlen (stmtblock_t *, gfc_constructor *, tree *); ! /* Generate a runtime error call. */ ! tree gfc_trans_runtime_error (bool, locus*, const char*, ...); ! tree gfc_trans_runtime_error_vararg (bool, locus*, const char*, va_list); ! ! /* Generate a runtime warning/error check. */ ! void gfc_trans_runtime_check (bool, bool, tree, stmtblock_t *, locus *, ! const char *, ...); ! ! /* Generate a runtime check for same string length. */ ! void gfc_trans_same_strlen_check (const char*, locus*, tree, tree, ! stmtblock_t*); /* Generate a call to free() after checking that its arg is non-NULL. */ tree gfc_call_free (tree); *************** tree gfc_call_free (tree); *** 453,466 **** /* Allocate memory after performing a few checks. */ tree gfc_call_malloc (stmtblock_t *, tree, tree); /* Allocate memory for arrays, with optional status variable. */ ! tree gfc_allocate_array_with_status (stmtblock_t *, tree, tree, tree); /* Allocate memory, with optional status variable. */ tree gfc_allocate_with_status (stmtblock_t *, tree, tree); /* Generate code to deallocate an array. */ ! tree gfc_deallocate_with_status (tree, tree, bool); /* Generate code to call realloc(). */ tree gfc_call_realloc (stmtblock_t *, tree, tree); --- 468,484 ---- /* Allocate memory after performing a few checks. */ tree gfc_call_malloc (stmtblock_t *, tree, tree); + /* Build a memcpy call. */ + tree gfc_build_memcpy_call (tree, tree, tree); + /* Allocate memory for arrays, with optional status variable. */ ! tree gfc_allocate_array_with_status (stmtblock_t*, tree, tree, tree, gfc_expr*); /* Allocate memory, with optional status variable. */ tree gfc_allocate_with_status (stmtblock_t *, tree, tree); /* Generate code to deallocate an array. */ ! tree gfc_deallocate_with_status (tree, tree, bool, gfc_expr*); /* Generate code to call realloc(). */ tree gfc_call_realloc (stmtblock_t *, tree, tree); *************** bool gfc_get_array_descr_info (const_tre *** 493,501 **** /* In trans-openmp.c */ bool gfc_omp_privatize_by_reference (const_tree); enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree); ! tree gfc_omp_clause_default_ctor (tree, tree); bool gfc_omp_disregard_value_expr (tree, bool); bool gfc_omp_private_debug_clause (tree, bool); struct gimplify_omp_ctx; void gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree); --- 511,523 ---- /* In trans-openmp.c */ bool gfc_omp_privatize_by_reference (const_tree); enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree); ! tree gfc_omp_clause_default_ctor (tree, tree, tree); ! tree gfc_omp_clause_copy_ctor (tree, tree, tree); ! tree gfc_omp_clause_assign_op (tree, tree, tree); ! tree gfc_omp_clause_dtor (tree, tree); bool gfc_omp_disregard_value_expr (tree, bool); bool gfc_omp_private_debug_clause (tree, bool); + bool gfc_omp_private_outer_ref (tree); struct gimplify_omp_ctx; void gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree); *************** extern GTY(()) tree gfor_fndecl_pause_nu *** 504,512 **** extern GTY(()) tree gfor_fndecl_pause_string; extern GTY(()) tree gfor_fndecl_stop_numeric; extern GTY(()) tree gfor_fndecl_stop_string; - extern GTY(()) tree gfor_fndecl_select_string; extern GTY(()) tree gfor_fndecl_runtime_error; extern GTY(()) tree gfor_fndecl_runtime_error_at; extern GTY(()) tree gfor_fndecl_os_error; extern GTY(()) tree gfor_fndecl_generate_error; extern GTY(()) tree gfor_fndecl_set_fpe; --- 526,534 ---- extern GTY(()) tree gfor_fndecl_pause_string; extern GTY(()) tree gfor_fndecl_stop_numeric; extern GTY(()) tree gfor_fndecl_stop_string; extern GTY(()) tree gfor_fndecl_runtime_error; extern GTY(()) tree gfor_fndecl_runtime_error_at; + extern GTY(()) tree gfor_fndecl_runtime_warning_at; extern GTY(()) tree gfor_fndecl_os_error; extern GTY(()) tree gfor_fndecl_generate_error; extern GTY(()) tree gfor_fndecl_set_fpe; *************** extern GTY(()) gfc_powdecl_list gfor_fnd *** 533,542 **** extern GTY(()) tree gfor_fndecl_math_ishftc4; extern GTY(()) tree gfor_fndecl_math_ishftc8; extern GTY(()) tree gfor_fndecl_math_ishftc16; - extern GTY(()) tree gfor_fndecl_math_exponent4; - extern GTY(()) tree gfor_fndecl_math_exponent8; - extern GTY(()) tree gfor_fndecl_math_exponent10; - extern GTY(()) tree gfor_fndecl_math_exponent16; /* BLAS functions. */ extern GTY(()) tree gfor_fndecl_sgemm; --- 555,560 ---- *************** extern GTY(()) tree gfor_fndecl_string_t *** 555,567 **** extern GTY(()) tree gfor_fndecl_string_minmax; extern GTY(()) tree gfor_fndecl_adjustl; extern GTY(()) tree gfor_fndecl_adjustr; /* Other misc. runtime library functions. */ extern GTY(()) tree gfor_fndecl_size0; extern GTY(()) tree gfor_fndecl_size1; extern GTY(()) tree gfor_fndecl_iargc; ! /* Implemented in FORTRAN. */ extern GTY(()) tree gfor_fndecl_si_kind; extern GTY(()) tree gfor_fndecl_sr_kind; --- 573,602 ---- extern GTY(()) tree gfor_fndecl_string_minmax; extern GTY(()) tree gfor_fndecl_adjustl; extern GTY(()) tree gfor_fndecl_adjustr; + extern GTY(()) tree gfor_fndecl_select_string; + extern GTY(()) tree gfor_fndecl_compare_string_char4; + extern GTY(()) tree gfor_fndecl_concat_string_char4; + extern GTY(()) tree gfor_fndecl_string_len_trim_char4; + extern GTY(()) tree gfor_fndecl_string_index_char4; + extern GTY(()) tree gfor_fndecl_string_scan_char4; + extern GTY(()) tree gfor_fndecl_string_verify_char4; + extern GTY(()) tree gfor_fndecl_string_trim_char4; + extern GTY(()) tree gfor_fndecl_string_minmax_char4; + extern GTY(()) tree gfor_fndecl_adjustl_char4; + extern GTY(()) tree gfor_fndecl_adjustr_char4; + extern GTY(()) tree gfor_fndecl_select_string_char4; + + /* Conversion between character kinds. */ + extern GTY(()) tree gfor_fndecl_convert_char1_to_char4; + extern GTY(()) tree gfor_fndecl_convert_char4_to_char1; /* Other misc. runtime library functions. */ extern GTY(()) tree gfor_fndecl_size0; extern GTY(()) tree gfor_fndecl_size1; extern GTY(()) tree gfor_fndecl_iargc; ! /* Implemented in Fortran. */ ! extern GTY(()) tree gfor_fndecl_sc_kind; extern GTY(()) tree gfor_fndecl_si_kind; extern GTY(()) tree gfor_fndecl_sr_kind; *************** struct lang_type GTY(()) *** 591,596 **** --- 626,632 ---- tree offset; tree dtype; tree dataptr_type; + tree span; }; struct lang_decl GTY(()) *************** struct lang_decl GTY(()) *** 638,655 **** #define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size) #define GFC_TYPE_ARRAY_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->offset) #define GFC_TYPE_ARRAY_AKIND(node) (TYPE_LANG_SPECIFIC(node)->akind) ! /* Code should use gfc_get_dtype instead of accesing this directly. It may not be known when the type is created. */ #define GFC_TYPE_ARRAY_DTYPE(node) (TYPE_LANG_SPECIFIC(node)->dtype) #define GFC_TYPE_ARRAY_DATAPTR_TYPE(node) \ (TYPE_LANG_SPECIFIC(node)->dataptr_type) /* Build an expression with void type. */ ! #define build1_v(code, arg) build1(code, void_type_node, arg) ! #define build2_v(code, arg1, arg2) build2(code, void_type_node, \ ! arg1, arg2) ! #define build3_v(code, arg1, arg2, arg3) build3(code, void_type_node, \ ! arg1, arg2, arg3) #define build4_v(code, arg1, arg2, arg3, arg4) build4(code, void_type_node, \ arg1, arg2, arg3, arg4) --- 674,692 ---- #define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size) #define GFC_TYPE_ARRAY_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->offset) #define GFC_TYPE_ARRAY_AKIND(node) (TYPE_LANG_SPECIFIC(node)->akind) ! /* Code should use gfc_get_dtype instead of accessing this directly. It may not be known when the type is created. */ #define GFC_TYPE_ARRAY_DTYPE(node) (TYPE_LANG_SPECIFIC(node)->dtype) #define GFC_TYPE_ARRAY_DATAPTR_TYPE(node) \ (TYPE_LANG_SPECIFIC(node)->dataptr_type) + #define GFC_TYPE_ARRAY_SPAN(node) (TYPE_LANG_SPECIFIC(node)->span) /* Build an expression with void type. */ ! #define build1_v(code, arg) fold_build1(code, void_type_node, arg) ! #define build2_v(code, arg1, arg2) fold_build2(code, void_type_node, \ ! arg1, arg2) ! #define build3_v(code, arg1, arg2, arg3) fold_build3(code, void_type_node, \ ! arg1, arg2, arg3) #define build4_v(code, arg1, arg2, arg3, arg4) build4(code, void_type_node, \ arg1, arg2, arg3, arg4) *************** typedef struct gfc_interface_sym_mapping *** 694,700 **** { struct gfc_interface_sym_mapping *next; gfc_symbol *old; ! gfc_symtree *new; gfc_expr *expr; } gfc_interface_sym_mapping; --- 731,737 ---- { struct gfc_interface_sym_mapping *next; gfc_symbol *old; ! gfc_symtree *new_sym; gfc_expr *expr; } gfc_interface_sym_mapping; diff -Nrcpad gcc-4.3.3/gcc/fortran/types.def gcc-4.4.0/gcc/fortran/types.def *** gcc-4.3.3/gcc/fortran/types.def Wed Aug 1 16:29:36 2007 --- gcc-4.4.0/gcc/fortran/types.def Fri Jun 6 13:01:54 2008 *************** *** 1,4 **** ! /* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. This file is part of GCC. --- 1,4 ---- ! /* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. This file is part of GCC. *************** along with GCC; see the file COPYING3. *** 50,59 **** the type pointed to. */ DEF_PRIMITIVE_TYPE (BT_VOID, void_type_node) ! DEF_PRIMITIVE_TYPE (BT_BOOL, boolean_type_node) DEF_PRIMITIVE_TYPE (BT_INT, integer_type_node) DEF_PRIMITIVE_TYPE (BT_UINT, unsigned_type_node) DEF_PRIMITIVE_TYPE (BT_LONG, long_integer_type_node) DEF_PRIMITIVE_TYPE (BT_WORD, (*lang_hooks.types.type_for_mode) (word_mode, 1)) DEF_PRIMITIVE_TYPE (BT_I1, builtin_type_for_size (BITS_PER_UNIT*1, 1)) --- 50,61 ---- the type pointed to. */ DEF_PRIMITIVE_TYPE (BT_VOID, void_type_node) ! DEF_PRIMITIVE_TYPE (BT_BOOL, ! (*lang_hooks.types.type_for_size) (BOOL_TYPE_SIZE, 1)) DEF_PRIMITIVE_TYPE (BT_INT, integer_type_node) DEF_PRIMITIVE_TYPE (BT_UINT, unsigned_type_node) DEF_PRIMITIVE_TYPE (BT_LONG, long_integer_type_node) + DEF_PRIMITIVE_TYPE (BT_ULONGLONG, long_long_unsigned_type_node) DEF_PRIMITIVE_TYPE (BT_WORD, (*lang_hooks.types.type_for_mode) (word_mode, 1)) DEF_PRIMITIVE_TYPE (BT_I1, builtin_type_for_size (BITS_PER_UNIT*1, 1)) *************** DEF_PRIMITIVE_TYPE (BT_VOLATILE_PTR, *** 70,75 **** --- 72,78 ---- TYPE_QUAL_VOLATILE))) DEF_POINTER_TYPE (BT_PTR_LONG, BT_LONG) + DEF_POINTER_TYPE (BT_PTR_ULONGLONG, BT_ULONGLONG) DEF_POINTER_TYPE (BT_PTR_PTR, BT_PTR) DEF_FUNCTION_TYPE_0 (BT_FN_BOOL, BT_BOOL) DEF_FUNCTION_TYPE_0 (BT_FN_PTR, BT_PTR) *************** DEF_POINTER_TYPE (BT_PTR_FN_VOID_PTR, BT *** 87,97 **** --- 90,105 ---- DEF_FUNCTION_TYPE_2 (BT_FN_BOOL_LONGPTR_LONGPTR, BT_BOOL, BT_PTR_LONG, BT_PTR_LONG) + DEF_FUNCTION_TYPE_2 (BT_FN_BOOL_ULONGLONGPTR_ULONGLONGPTR, + BT_BOOL, BT_PTR_ULONGLONG, BT_PTR_ULONGLONG) DEF_FUNCTION_TYPE_2 (BT_FN_I1_VPTR_I1, BT_I1, BT_VOLATILE_PTR, BT_I1) DEF_FUNCTION_TYPE_2 (BT_FN_I2_VPTR_I2, BT_I2, BT_VOLATILE_PTR, BT_I2) DEF_FUNCTION_TYPE_2 (BT_FN_I4_VPTR_I4, BT_I4, BT_VOLATILE_PTR, BT_I4) DEF_FUNCTION_TYPE_2 (BT_FN_I8_VPTR_I8, BT_I8, BT_VOLATILE_PTR, BT_I8) DEF_FUNCTION_TYPE_2 (BT_FN_I16_VPTR_I16, BT_I16, BT_VOLATILE_PTR, BT_I16) + DEF_FUNCTION_TYPE_2 (BT_FN_VOID_PTR_PTR, BT_VOID, BT_PTR, BT_PTR) + + DEF_POINTER_TYPE (BT_PTR_FN_VOID_PTR_PTR, BT_FN_VOID_PTR_PTR) DEF_FUNCTION_TYPE_3 (BT_FN_BOOL_VPTR_I1_I1, BT_BOOL, BT_VOLATILE_PTR, BT_I1, BT_I1) *************** DEF_FUNCTION_TYPE_6 (BT_FN_BOOL_LONG_LON *** 127,135 **** --- 135,154 ---- DEF_FUNCTION_TYPE_6 (BT_FN_VOID_OMPFN_PTR_UINT_LONG_LONG_LONG, BT_VOID, BT_PTR_FN_VOID_PTR, BT_PTR, BT_UINT, BT_LONG, BT_LONG, BT_LONG) + DEF_FUNCTION_TYPE_6 (BT_FN_BOOL_BOOL_ULL_ULL_ULL_ULLPTR_ULLPTR, + BT_BOOL, BT_BOOL, BT_ULONGLONG, BT_ULONGLONG, + BT_ULONGLONG, BT_PTR_ULONGLONG, BT_PTR_ULONGLONG) DEF_FUNCTION_TYPE_7 (BT_FN_VOID_OMPFN_PTR_UINT_LONG_LONG_LONG_LONG, BT_VOID, BT_PTR_FN_VOID_PTR, BT_PTR, BT_UINT, BT_LONG, BT_LONG, BT_LONG, BT_LONG) + DEF_FUNCTION_TYPE_7 (BT_FN_VOID_OMPFN_PTR_OMPCPYFN_LONG_LONG_BOOL_UINT, + BT_VOID, BT_PTR_FN_VOID_PTR, BT_PTR, + BT_PTR_FN_VOID_PTR_PTR, BT_LONG, BT_LONG, + BT_BOOL, BT_UINT) + DEF_FUNCTION_TYPE_7 (BT_FN_BOOL_BOOL_ULL_ULL_ULL_ULL_ULLPTR_ULLPTR, + BT_BOOL, BT_BOOL, BT_ULONGLONG, BT_ULONGLONG, + BT_ULONGLONG, BT_ULONGLONG, + BT_PTR_ULONGLONG, BT_PTR_ULONGLONG) DEF_FUNCTION_TYPE_VAR_0 (BT_FN_VOID_VAR, BT_VOID) diff -Nrcpad gcc-4.3.3/libgfortran/ChangeLog gcc-4.4.0/libgfortran/ChangeLog *** gcc-4.3.3/libgfortran/ChangeLog Sat Jan 24 10:16:47 2009 --- gcc-4.4.0/libgfortran/ChangeLog Tue Apr 21 08:47:03 2009 *************** *** 1,8 **** ! 2009-01-24 Release Manager ! * GCC 4.3.3 released. ! 2008-12-31 John David Anglin PR fortran/31832 * acinclude.m4 (LIBGFOR_CHECK_FOR_BROKEN_POWF): New autoconf check for --- 1,682 ---- ! 2009-04-21 Release Manager ! * GCC 4.4.0 released. ! 2009-04-09 Nick Clifton ! ! * m4/cshift0.m4: Change copyright header to refer to version 3 ! of the GNU General Public License with version 3.1 of the GCC ! Runtime Library Exception and to point readers at the COPYING3 ! and COPYING3.RUNTIME files and the FSF's license web page. ! * c99_protos.h: Likewise. ! * config/fpu-387.h: Likewise. ! * config/fpu-aix.h: Likewise. ! * config/fpu-generic.h: Likewise. ! * config/fpu-glibc.h: Likewise. ! * config/fpu-sysv.h: Likewise. ! * intrinsics/abort.c: Likewise. ! * intrinsics/access.c: Likewise. ! * intrinsics/args.c: Likewise. ! * intrinsics/associated.c: Likewise. ! * intrinsics/c99_functions.c: Likewise. ! * intrinsics/chdir.c: Likewise. ! * intrinsics/chmod.c: Likewise. ! * intrinsics/clock.c: Likewise. ! * intrinsics/cpu_time.c: Likewise. ! * intrinsics/cshift0.c: Likewise. ! * intrinsics/ctime.c: Likewise. ! * intrinsics/date_and_time.c: Likewise. ! * intrinsics/dprod_r8.f90: Likewise. ! * intrinsics/dtime.c: Likewise. ! * intrinsics/env.c: Likewise. ! * intrinsics/eoshift0.c: Likewise. ! * intrinsics/eoshift2.c: Likewise. ! * intrinsics/erfc_scaled.c: Likewise. ! * intrinsics/erfc_scaled_inc.c: Likewise. ! * intrinsics/etime.c: Likewise. ! * intrinsics/exit.c: Likewise. ! * intrinsics/f2c_specifics.F90: Likewise. ! * intrinsics/fnum.c: Likewise. ! * intrinsics/gerror.c: Likewise. ! * intrinsics/getXid.c: Likewise. ! * intrinsics/getcwd.c: Likewise. ! * intrinsics/getlog.c: Likewise. ! * intrinsics/hostnm.c: Likewise. ! * intrinsics/ierrno.c: Likewise. ! * intrinsics/ishftc.c: Likewise. ! * intrinsics/iso_c_binding.c: Likewise. ! * intrinsics/iso_c_binding.h: Likewise. ! * intrinsics/iso_c_generated_procs.c: Likewise. ! * intrinsics/kill.c: Likewise. ! * intrinsics/link.c: Likewise. ! * intrinsics/malloc.c: Likewise. ! * intrinsics/move_alloc.c: Likewise. ! * intrinsics/mvbits.c: Likewise. ! * intrinsics/pack_generic.c: Likewise. ! * intrinsics/perror.c: Likewise. ! * intrinsics/rand.c: Likewise. ! * intrinsics/random.c: Likewise. ! * intrinsics/rename.c: Likewise. ! * intrinsics/reshape_generic.c: Likewise. ! * intrinsics/reshape_packed.c: Likewise. ! * intrinsics/selected_char_kind.c: Likewise. ! * intrinsics/selected_int_kind.f90: Likewise. ! * intrinsics/selected_real_kind.f90: Likewise. ! * intrinsics/signal.c: Likewise. ! * intrinsics/size.c: Likewise. ! * intrinsics/sleep.c: Likewise. ! * intrinsics/spread_generic.c: Likewise. ! * intrinsics/stat.c: Likewise. ! * intrinsics/string_intrinsics.c: Likewise. ! * intrinsics/string_intrinsics_inc.c: Likewise. ! * intrinsics/symlnk.c: Likewise. ! * intrinsics/system.c: Likewise. ! * intrinsics/system_clock.c: Likewise. ! * intrinsics/time.c: Likewise. ! * intrinsics/time_1.h: Likewise. ! * intrinsics/transpose_generic.c: Likewise. ! * intrinsics/umask.c: Likewise. ! * intrinsics/unlink.c: Likewise. ! * intrinsics/unpack_generic.c: Likewise. ! * io/close.c: Likewise. ! * io/fbuf.c: Likewise. ! * io/file_pos.c: Likewise. ! * io/format.c: Likewise. ! * io/inquire.c: Likewise. ! * io/intrinsics.c: Likewise. ! * io/io.h: Likewise. ! * io/list_read.c: Likewise. ! * io/lock.c: Likewise. ! * io/open.c: Likewise. ! * io/read.c: Likewise. ! * io/size_from_kind.c: Likewise. ! * io/transfer.c: Likewise. ! * io/unit.c: Likewise. ! * io/unix.c: Likewise. ! * io/write.c: Likewise. ! * io/write_float.def: Likewise. ! * libgfortran.h: Likewise. ! * m4/all.m4: Likewise. ! * m4/any.m4: Likewise. ! * m4/count.m4: Likewise. ! * m4/cshift1.m4: Likewise. ! * m4/eoshift1.m4: Likewise. ! * m4/eoshift3.m4: Likewise. ! * m4/exponent.m4: Likewise. ! * m4/fraction.m4: Likewise. ! * m4/head.m4: Likewise. ! * m4/in_pack.m4: Likewise. ! * m4/in_unpack.m4: Likewise. ! * m4/matmul.m4: Likewise. ! * m4/matmull.m4: Likewise. ! * m4/maxloc0.m4: Likewise. ! * m4/maxloc1.m4: Likewise. ! * m4/maxval.m4: Likewise. ! * m4/minloc0.m4: Likewise. ! * m4/minloc1.m4: Likewise. ! * m4/minval.m4: Likewise. ! * m4/nearest.m4: Likewise. ! * m4/pack.m4: Likewise. ! * m4/pow.m4: Likewise. ! * m4/product.m4: Likewise. ! * m4/reshape.m4: Likewise. ! * m4/rrspacing.m4: Likewise. ! * m4/set_exponent.m4: Likewise. ! * m4/shape.m4: Likewise. ! * m4/spacing.m4: Likewise. ! * m4/spread.m4: Likewise. ! * m4/sum.m4: Likewise. ! * m4/transpose.m4: Likewise. ! * m4/unpack.m4: Likewise. ! * runtime/backtrace.c: Likewise. ! * runtime/compile_options.c: Likewise. ! * runtime/convert_char.c: Likewise. ! * runtime/environ.c: Likewise. ! * runtime/error.c: Likewise. ! * runtime/in_pack_generic.c: Likewise. ! * runtime/in_unpack_generic.c: Likewise. ! * runtime/main.c: Likewise. ! * runtime/memory.c: Likewise. ! * runtime/pause.c: Likewise. ! * runtime/select.c: Likewise. ! * runtime/select_inc.c: Likewise. ! * runtime/stop.c: Likewise. ! * runtime/string.c: Likewise. ! * generated/_abs_c10.F90: Regenerate. ! * generated/_abs_c16.F90: Regenerate. ! * generated/_abs_c4.F90: Regenerate. ! * generated/_abs_c8.F90: Regenerate. ! * generated/_abs_i16.F90: Regenerate. ! * generated/_abs_i4.F90: Regenerate. ! * generated/_abs_i8.F90: Regenerate. ! * generated/_abs_r10.F90: Regenerate. ! * generated/_abs_r16.F90: Regenerate. ! * generated/_abs_r4.F90: Regenerate. ! * generated/_abs_r8.F90: Regenerate. ! * generated/_acos_r10.F90: Regenerate. ! * generated/_acos_r16.F90: Regenerate. ! * generated/_acos_r4.F90: Regenerate. ! * generated/_acos_r8.F90: Regenerate. ! * generated/_acosh_r10.F90: Regenerate. ! * generated/_acosh_r16.F90: Regenerate. ! * generated/_acosh_r4.F90: Regenerate. ! * generated/_acosh_r8.F90: Regenerate. ! * generated/_aimag_c10.F90: Regenerate. ! * generated/_aimag_c16.F90: Regenerate. ! * generated/_aimag_c4.F90: Regenerate. ! * generated/_aimag_c8.F90: Regenerate. ! * generated/_aint_r10.F90: Regenerate. ! * generated/_aint_r16.F90: Regenerate. ! * generated/_aint_r4.F90: Regenerate. ! * generated/_aint_r8.F90: Regenerate. ! * generated/_anint_r10.F90: Regenerate. ! * generated/_anint_r16.F90: Regenerate. ! * generated/_anint_r4.F90: Regenerate. ! * generated/_anint_r8.F90: Regenerate. ! * generated/_asin_r10.F90: Regenerate. ! * generated/_asin_r16.F90: Regenerate. ! * generated/_asin_r4.F90: Regenerate. ! * generated/_asin_r8.F90: Regenerate. ! * generated/_asinh_r10.F90: Regenerate. ! * generated/_asinh_r16.F90: Regenerate. ! * generated/_asinh_r4.F90: Regenerate. ! * generated/_asinh_r8.F90: Regenerate. ! * generated/_atan2_r10.F90: Regenerate. ! * generated/_atan2_r16.F90: Regenerate. ! * generated/_atan2_r4.F90: Regenerate. ! * generated/_atan2_r8.F90: Regenerate. ! * generated/_atan_r10.F90: Regenerate. ! * generated/_atan_r16.F90: Regenerate. ! * generated/_atan_r4.F90: Regenerate. ! * generated/_atan_r8.F90: Regenerate. ! * generated/_atanh_r10.F90: Regenerate. ! * generated/_atanh_r16.F90: Regenerate. ! * generated/_atanh_r4.F90: Regenerate. ! * generated/_atanh_r8.F90: Regenerate. ! * generated/_conjg_c10.F90: Regenerate. ! * generated/_conjg_c16.F90: Regenerate. ! * generated/_conjg_c4.F90: Regenerate. ! * generated/_conjg_c8.F90: Regenerate. ! * generated/_cos_c10.F90: Regenerate. ! * generated/_cos_c16.F90: Regenerate. ! * generated/_cos_c4.F90: Regenerate. ! * generated/_cos_c8.F90: Regenerate. ! * generated/_cos_r10.F90: Regenerate. ! * generated/_cos_r16.F90: Regenerate. ! * generated/_cos_r4.F90: Regenerate. ! * generated/_cos_r8.F90: Regenerate. ! * generated/_cosh_r10.F90: Regenerate. ! * generated/_cosh_r16.F90: Regenerate. ! * generated/_cosh_r4.F90: Regenerate. ! * generated/_cosh_r8.F90: Regenerate. ! * generated/_dim_i16.F90: Regenerate. ! * generated/_dim_i4.F90: Regenerate. ! * generated/_dim_i8.F90: Regenerate. ! * generated/_dim_r10.F90: Regenerate. ! * generated/_dim_r16.F90: Regenerate. ! * generated/_dim_r4.F90: Regenerate. ! * generated/_dim_r8.F90: Regenerate. ! * generated/_exp_c10.F90: Regenerate. ! * generated/_exp_c16.F90: Regenerate. ! * generated/_exp_c4.F90: Regenerate. ! * generated/_exp_c8.F90: Regenerate. ! * generated/_exp_r10.F90: Regenerate. ! * generated/_exp_r16.F90: Regenerate. ! * generated/_exp_r4.F90: Regenerate. ! * generated/_exp_r8.F90: Regenerate. ! * generated/_log10_r10.F90: Regenerate. ! * generated/_log10_r16.F90: Regenerate. ! * generated/_log10_r4.F90: Regenerate. ! * generated/_log10_r8.F90: Regenerate. ! * generated/_log_c10.F90: Regenerate. ! * generated/_log_c16.F90: Regenerate. ! * generated/_log_c4.F90: Regenerate. ! * generated/_log_c8.F90: Regenerate. ! * generated/_log_r10.F90: Regenerate. ! * generated/_log_r16.F90: Regenerate. ! * generated/_log_r4.F90: Regenerate. ! * generated/_log_r8.F90: Regenerate. ! * generated/_mod_i16.F90: Regenerate. ! * generated/_mod_i4.F90: Regenerate. ! * generated/_mod_i8.F90: Regenerate. ! * generated/_mod_r10.F90: Regenerate. ! * generated/_mod_r16.F90: Regenerate. ! * generated/_mod_r4.F90: Regenerate. ! * generated/_mod_r8.F90: Regenerate. ! * generated/_sign_i16.F90: Regenerate. ! * generated/_sign_i4.F90: Regenerate. ! * generated/_sign_i8.F90: Regenerate. ! * generated/_sign_r10.F90: Regenerate. ! * generated/_sign_r16.F90: Regenerate. ! * generated/_sign_r4.F90: Regenerate. ! * generated/_sign_r8.F90: Regenerate. ! * generated/_sin_c10.F90: Regenerate. ! * generated/_sin_c16.F90: Regenerate. ! * generated/_sin_c4.F90: Regenerate. ! * generated/_sin_c8.F90: Regenerate. ! * generated/_sin_r10.F90: Regenerate. ! * generated/_sin_r16.F90: Regenerate. ! * generated/_sin_r4.F90: Regenerate. ! * generated/_sin_r8.F90: Regenerate. ! * generated/_sinh_r10.F90: Regenerate. ! * generated/_sinh_r16.F90: Regenerate. ! * generated/_sinh_r4.F90: Regenerate. ! * generated/_sinh_r8.F90: Regenerate. ! * generated/_sqrt_c10.F90: Regenerate. ! * generated/_sqrt_c16.F90: Regenerate. ! * generated/_sqrt_c4.F90: Regenerate. ! * generated/_sqrt_c8.F90: Regenerate. ! * generated/_sqrt_r10.F90: Regenerate. ! * generated/_sqrt_r16.F90: Regenerate. ! * generated/_sqrt_r4.F90: Regenerate. ! * generated/_sqrt_r8.F90: Regenerate. ! * generated/_tan_r10.F90: Regenerate. ! * generated/_tan_r16.F90: Regenerate. ! * generated/_tan_r4.F90: Regenerate. ! * generated/_tan_r8.F90: Regenerate. ! * generated/_tanh_r10.F90: Regenerate. ! * generated/_tanh_r16.F90: Regenerate. ! * generated/_tanh_r4.F90: Regenerate. ! * generated/_tanh_r8.F90: Regenerate. ! * generated/all_l1.c: Regenerate. ! * generated/all_l16.c: Regenerate. ! * generated/all_l2.c: Regenerate. ! * generated/all_l4.c: Regenerate. ! * generated/all_l8.c: Regenerate. ! * generated/any_l1.c: Regenerate. ! * generated/any_l16.c: Regenerate. ! * generated/any_l2.c: Regenerate. ! * generated/any_l4.c: Regenerate. ! * generated/any_l8.c: Regenerate. ! * generated/count_16_l.c: Regenerate. ! * generated/count_1_l.c: Regenerate. ! * generated/count_2_l.c: Regenerate. ! * generated/count_4_l.c: Regenerate. ! * generated/count_8_l.c: Regenerate. ! * generated/cshift0_c10.c: Regenerate. ! * generated/cshift0_c16.c: Regenerate. ! * generated/cshift0_c4.c: Regenerate. ! * generated/cshift0_c8.c: Regenerate. ! * generated/cshift0_i1.c: Regenerate. ! * generated/cshift0_i16.c: Regenerate. ! * generated/cshift0_i2.c: Regenerate. ! * generated/cshift0_i4.c: Regenerate. ! * generated/cshift0_i8.c: Regenerate. ! * generated/cshift0_r10.c: Regenerate. ! * generated/cshift0_r16.c: Regenerate. ! * generated/cshift0_r4.c: Regenerate. ! * generated/cshift0_r8.c: Regenerate. ! * generated/cshift1_16.c: Regenerate. ! * generated/cshift1_4.c: Regenerate. ! * generated/cshift1_8.c: Regenerate. ! * generated/eoshift1_16.c: Regenerate. ! * generated/eoshift1_4.c: Regenerate. ! * generated/eoshift1_8.c: Regenerate. ! * generated/eoshift3_16.c: Regenerate. ! * generated/eoshift3_4.c: Regenerate. ! * generated/eoshift3_8.c: Regenerate. ! * generated/exponent_r10.c: Regenerate. ! * generated/exponent_r16.c: Regenerate. ! * generated/exponent_r4.c: Regenerate. ! * generated/exponent_r8.c: Regenerate. ! * generated/fraction_r10.c: Regenerate. ! * generated/fraction_r16.c: Regenerate. ! * generated/fraction_r4.c: Regenerate. ! * generated/fraction_r8.c: Regenerate. ! * generated/in_pack_c10.c: Regenerate. ! * generated/in_pack_c16.c: Regenerate. ! * generated/in_pack_c4.c: Regenerate. ! * generated/in_pack_c8.c: Regenerate. ! * generated/in_pack_i1.c: Regenerate. ! * generated/in_pack_i16.c: Regenerate. ! * generated/in_pack_i2.c: Regenerate. ! * generated/in_pack_i4.c: Regenerate. ! * generated/in_pack_i8.c: Regenerate. ! * generated/in_pack_r10.c: Regenerate. ! * generated/in_pack_r16.c: Regenerate. ! * generated/in_pack_r4.c: Regenerate. ! * generated/in_pack_r8.c: Regenerate. ! * generated/in_unpack_c10.c: Regenerate. ! * generated/in_unpack_c16.c: Regenerate. ! * generated/in_unpack_c4.c: Regenerate. ! * generated/in_unpack_c8.c: Regenerate. ! * generated/in_unpack_i1.c: Regenerate. ! * generated/in_unpack_i16.c: Regenerate. ! * generated/in_unpack_i2.c: Regenerate. ! * generated/in_unpack_i4.c: Regenerate. ! * generated/in_unpack_i8.c: Regenerate. ! * generated/in_unpack_r10.c: Regenerate. ! * generated/in_unpack_r16.c: Regenerate. ! * generated/in_unpack_r4.c: Regenerate. ! * generated/in_unpack_r8.c: Regenerate. ! * generated/matmul_c10.c: Regenerate. ! * generated/matmul_c16.c: Regenerate. ! * generated/matmul_c4.c: Regenerate. ! * generated/matmul_c8.c: Regenerate. ! * generated/matmul_i1.c: Regenerate. ! * generated/matmul_i16.c: Regenerate. ! * generated/matmul_i2.c: Regenerate. ! * generated/matmul_i4.c: Regenerate. ! * generated/matmul_i8.c: Regenerate. ! * generated/matmul_l16.c: Regenerate. ! * generated/matmul_l4.c: Regenerate. ! * generated/matmul_l8.c: Regenerate. ! * generated/matmul_r10.c: Regenerate. ! * generated/matmul_r16.c: Regenerate. ! * generated/matmul_r4.c: Regenerate. ! * generated/matmul_r8.c: Regenerate. ! * generated/maxloc0_16_i1.c: Regenerate. ! * generated/maxloc0_16_i16.c: Regenerate. ! * generated/maxloc0_16_i2.c: Regenerate. ! * generated/maxloc0_16_i4.c: Regenerate. ! * generated/maxloc0_16_i8.c: Regenerate. ! * generated/maxloc0_16_r10.c: Regenerate. ! * generated/maxloc0_16_r16.c: Regenerate. ! * generated/maxloc0_16_r4.c: Regenerate. ! * generated/maxloc0_16_r8.c: Regenerate. ! * generated/maxloc0_4_i1.c: Regenerate. ! * generated/maxloc0_4_i16.c: Regenerate. ! * generated/maxloc0_4_i2.c: Regenerate. ! * generated/maxloc0_4_i4.c: Regenerate. ! * generated/maxloc0_4_i8.c: Regenerate. ! * generated/maxloc0_4_r10.c: Regenerate. ! * generated/maxloc0_4_r16.c: Regenerate. ! * generated/maxloc0_4_r4.c: Regenerate. ! * generated/maxloc0_4_r8.c: Regenerate. ! * generated/maxloc0_8_i1.c: Regenerate. ! * generated/maxloc0_8_i16.c: Regenerate. ! * generated/maxloc0_8_i2.c: Regenerate. ! * generated/maxloc0_8_i4.c: Regenerate. ! * generated/maxloc0_8_i8.c: Regenerate. ! * generated/maxloc0_8_r10.c: Regenerate. ! * generated/maxloc0_8_r16.c: Regenerate. ! * generated/maxloc0_8_r4.c: Regenerate. ! * generated/maxloc0_8_r8.c: Regenerate. ! * generated/maxloc1_16_i1.c: Regenerate. ! * generated/maxloc1_16_i16.c: Regenerate. ! * generated/maxloc1_16_i2.c: Regenerate. ! * generated/maxloc1_16_i4.c: Regenerate. ! * generated/maxloc1_16_i8.c: Regenerate. ! * generated/maxloc1_16_r10.c: Regenerate. ! * generated/maxloc1_16_r16.c: Regenerate. ! * generated/maxloc1_16_r4.c: Regenerate. ! * generated/maxloc1_16_r8.c: Regenerate. ! * generated/maxloc1_4_i1.c: Regenerate. ! * generated/maxloc1_4_i16.c: Regenerate. ! * generated/maxloc1_4_i2.c: Regenerate. ! * generated/maxloc1_4_i4.c: Regenerate. ! * generated/maxloc1_4_i8.c: Regenerate. ! * generated/maxloc1_4_r10.c: Regenerate. ! * generated/maxloc1_4_r16.c: Regenerate. ! * generated/maxloc1_4_r4.c: Regenerate. ! * generated/maxloc1_4_r8.c: Regenerate. ! * generated/maxloc1_8_i1.c: Regenerate. ! * generated/maxloc1_8_i16.c: Regenerate. ! * generated/maxloc1_8_i2.c: Regenerate. ! * generated/maxloc1_8_i4.c: Regenerate. ! * generated/maxloc1_8_i8.c: Regenerate. ! * generated/maxloc1_8_r10.c: Regenerate. ! * generated/maxloc1_8_r16.c: Regenerate. ! * generated/maxloc1_8_r4.c: Regenerate. ! * generated/maxloc1_8_r8.c: Regenerate. ! * generated/maxval_i1.c: Regenerate. ! * generated/maxval_i16.c: Regenerate. ! * generated/maxval_i2.c: Regenerate. ! * generated/maxval_i4.c: Regenerate. ! * generated/maxval_i8.c: Regenerate. ! * generated/maxval_r10.c: Regenerate. ! * generated/maxval_r16.c: Regenerate. ! * generated/maxval_r4.c: Regenerate. ! * generated/maxval_r8.c: Regenerate. ! * generated/minloc0_16_i1.c: Regenerate. ! * generated/minloc0_16_i16.c: Regenerate. ! * generated/minloc0_16_i2.c: Regenerate. ! * generated/minloc0_16_i4.c: Regenerate. ! * generated/minloc0_16_i8.c: Regenerate. ! * generated/minloc0_16_r10.c: Regenerate. ! * generated/minloc0_16_r16.c: Regenerate. ! * generated/minloc0_16_r4.c: Regenerate. ! * generated/minloc0_16_r8.c: Regenerate. ! * generated/minloc0_4_i1.c: Regenerate. ! * generated/minloc0_4_i16.c: Regenerate. ! * generated/minloc0_4_i2.c: Regenerate. ! * generated/minloc0_4_i4.c: Regenerate. ! * generated/minloc0_4_i8.c: Regenerate. ! * generated/minloc0_4_r10.c: Regenerate. ! * generated/minloc0_4_r16.c: Regenerate. ! * generated/minloc0_4_r4.c: Regenerate. ! * generated/minloc0_4_r8.c: Regenerate. ! * generated/minloc0_8_i1.c: Regenerate. ! * generated/minloc0_8_i16.c: Regenerate. ! * generated/minloc0_8_i2.c: Regenerate. ! * generated/minloc0_8_i4.c: Regenerate. ! * generated/minloc0_8_i8.c: Regenerate. ! * generated/minloc0_8_r10.c: Regenerate. ! * generated/minloc0_8_r16.c: Regenerate. ! * generated/minloc0_8_r4.c: Regenerate. ! * generated/minloc0_8_r8.c: Regenerate. ! * generated/minloc1_16_i1.c: Regenerate. ! * generated/minloc1_16_i16.c: Regenerate. ! * generated/minloc1_16_i2.c: Regenerate. ! * generated/minloc1_16_i4.c: Regenerate. ! * generated/minloc1_16_i8.c: Regenerate. ! * generated/minloc1_16_r10.c: Regenerate. ! * generated/minloc1_16_r16.c: Regenerate. ! * generated/minloc1_16_r4.c: Regenerate. ! * generated/minloc1_16_r8.c: Regenerate. ! * generated/minloc1_4_i1.c: Regenerate. ! * generated/minloc1_4_i16.c: Regenerate. ! * generated/minloc1_4_i2.c: Regenerate. ! * generated/minloc1_4_i4.c: Regenerate. ! * generated/minloc1_4_i8.c: Regenerate. ! * generated/minloc1_4_r10.c: Regenerate. ! * generated/minloc1_4_r16.c: Regenerate. ! * generated/minloc1_4_r4.c: Regenerate. ! * generated/minloc1_4_r8.c: Regenerate. ! * generated/minloc1_8_i1.c: Regenerate. ! * generated/minloc1_8_i16.c: Regenerate. ! * generated/minloc1_8_i2.c: Regenerate. ! * generated/minloc1_8_i4.c: Regenerate. ! * generated/minloc1_8_i8.c: Regenerate. ! * generated/minloc1_8_r10.c: Regenerate. ! * generated/minloc1_8_r16.c: Regenerate. ! * generated/minloc1_8_r4.c: Regenerate. ! * generated/minloc1_8_r8.c: Regenerate. ! * generated/minval_i1.c: Regenerate. ! * generated/minval_i16.c: Regenerate. ! * generated/minval_i2.c: Regenerate. ! * generated/minval_i4.c: Regenerate. ! * generated/minval_i8.c: Regenerate. ! * generated/minval_r10.c: Regenerate. ! * generated/minval_r16.c: Regenerate. ! * generated/minval_r4.c: Regenerate. ! * generated/minval_r8.c: Regenerate. ! * generated/misc_specifics.F90: Regenerate. ! * generated/nearest_r10.c: Regenerate. ! * generated/nearest_r16.c: Regenerate. ! * generated/nearest_r4.c: Regenerate. ! * generated/nearest_r8.c: Regenerate. ! * generated/pack_c10.c: Regenerate. ! * generated/pack_c16.c: Regenerate. ! * generated/pack_c4.c: Regenerate. ! * generated/pack_c8.c: Regenerate. ! * generated/pack_i1.c: Regenerate. ! * generated/pack_i16.c: Regenerate. ! * generated/pack_i2.c: Regenerate. ! * generated/pack_i4.c: Regenerate. ! * generated/pack_i8.c: Regenerate. ! * generated/pack_r10.c: Regenerate. ! * generated/pack_r16.c: Regenerate. ! * generated/pack_r4.c: Regenerate. ! * generated/pack_r8.c: Regenerate. ! * generated/pow_c10_i16.c: Regenerate. ! * generated/pow_c10_i4.c: Regenerate. ! * generated/pow_c10_i8.c: Regenerate. ! * generated/pow_c16_i16.c: Regenerate. ! * generated/pow_c16_i4.c: Regenerate. ! * generated/pow_c16_i8.c: Regenerate. ! * generated/pow_c4_i16.c: Regenerate. ! * generated/pow_c4_i4.c: Regenerate. ! * generated/pow_c4_i8.c: Regenerate. ! * generated/pow_c8_i16.c: Regenerate. ! * generated/pow_c8_i4.c: Regenerate. ! * generated/pow_c8_i8.c: Regenerate. ! * generated/pow_i16_i16.c: Regenerate. ! * generated/pow_i16_i4.c: Regenerate. ! * generated/pow_i16_i8.c: Regenerate. ! * generated/pow_i4_i16.c: Regenerate. ! * generated/pow_i4_i4.c: Regenerate. ! * generated/pow_i4_i8.c: Regenerate. ! * generated/pow_i8_i16.c: Regenerate. ! * generated/pow_i8_i4.c: Regenerate. ! * generated/pow_i8_i8.c: Regenerate. ! * generated/pow_r10_i16.c: Regenerate. ! * generated/pow_r10_i8.c: Regenerate. ! * generated/pow_r16_i16.c: Regenerate. ! * generated/pow_r16_i8.c: Regenerate. ! * generated/pow_r4_i16.c: Regenerate. ! * generated/pow_r4_i8.c: Regenerate. ! * generated/pow_r8_i16.c: Regenerate. ! * generated/pow_r8_i8.c: Regenerate. ! * generated/product_c10.c: Regenerate. ! * generated/product_c16.c: Regenerate. ! * generated/product_c4.c: Regenerate. ! * generated/product_c8.c: Regenerate. ! * generated/product_i1.c: Regenerate. ! * generated/product_i16.c: Regenerate. ! * generated/product_i2.c: Regenerate. ! * generated/product_i4.c: Regenerate. ! * generated/product_i8.c: Regenerate. ! * generated/product_r10.c: Regenerate. ! * generated/product_r16.c: Regenerate. ! * generated/product_r4.c: Regenerate. ! * generated/product_r8.c: Regenerate. ! * generated/reshape_c10.c: Regenerate. ! * generated/reshape_c16.c: Regenerate. ! * generated/reshape_c4.c: Regenerate. ! * generated/reshape_c8.c: Regenerate. ! * generated/reshape_i16.c: Regenerate. ! * generated/reshape_i4.c: Regenerate. ! * generated/reshape_i8.c: Regenerate. ! * generated/reshape_r10.c: Regenerate. ! * generated/reshape_r16.c: Regenerate. ! * generated/reshape_r4.c: Regenerate. ! * generated/reshape_r8.c: Regenerate. ! * generated/rrspacing_r10.c: Regenerate. ! * generated/rrspacing_r16.c: Regenerate. ! * generated/rrspacing_r4.c: Regenerate. ! * generated/rrspacing_r8.c: Regenerate. ! * generated/set_exponent_r10.c: Regenerate. ! * generated/set_exponent_r16.c: Regenerate. ! * generated/set_exponent_r4.c: Regenerate. ! * generated/set_exponent_r8.c: Regenerate. ! * generated/shape_i16.c: Regenerate. ! * generated/shape_i4.c: Regenerate. ! * generated/shape_i8.c: Regenerate. ! * generated/spacing_r10.c: Regenerate. ! * generated/spacing_r16.c: Regenerate. ! * generated/spacing_r4.c: Regenerate. ! * generated/spacing_r8.c: Regenerate. ! * generated/spread_c10.c: Regenerate. ! * generated/spread_c16.c: Regenerate. ! * generated/spread_c4.c: Regenerate. ! * generated/spread_c8.c: Regenerate. ! * generated/spread_i1.c: Regenerate. ! * generated/spread_i16.c: Regenerate. ! * generated/spread_i2.c: Regenerate. ! * generated/spread_i4.c: Regenerate. ! * generated/spread_i8.c: Regenerate. ! * generated/spread_r10.c: Regenerate. ! * generated/spread_r16.c: Regenerate. ! * generated/spread_r4.c: Regenerate. ! * generated/spread_r8.c: Regenerate. ! * generated/sum_c10.c: Regenerate. ! * generated/sum_c16.c: Regenerate. ! * generated/sum_c4.c: Regenerate. ! * generated/sum_c8.c: Regenerate. ! * generated/sum_i1.c: Regenerate. ! * generated/sum_i16.c: Regenerate. ! * generated/sum_i2.c: Regenerate. ! * generated/sum_i4.c: Regenerate. ! * generated/sum_i8.c: Regenerate. ! * generated/sum_r10.c: Regenerate. ! * generated/sum_r16.c: Regenerate. ! * generated/sum_r4.c: Regenerate. ! * generated/sum_r8.c: Regenerate. ! * generated/transpose_c10.c: Regenerate. ! * generated/transpose_c16.c: Regenerate. ! * generated/transpose_c4.c: Regenerate. ! * generated/transpose_c8.c: Regenerate. ! * generated/transpose_i16.c: Regenerate. ! * generated/transpose_i4.c: Regenerate. ! * generated/transpose_i8.c: Regenerate. ! * generated/transpose_r10.c: Regenerate. ! * generated/transpose_r16.c: Regenerate. ! * generated/transpose_r4.c: Regenerate. ! * generated/transpose_r8.c: Regenerate. ! * generated/unpack_c10.c: Regenerate. ! * generated/unpack_c16.c: Regenerate. ! * generated/unpack_c4.c: Regenerate. ! * generated/unpack_c8.c: Regenerate. ! * generated/unpack_i1.c: Regenerate. ! * generated/unpack_i16.c: Regenerate. ! * generated/unpack_i2.c: Regenerate. ! * generated/unpack_i4.c: Regenerate. ! * generated/unpack_i8.c: Regenerate. ! * generated/unpack_r10.c: Regenerate. ! * generated/unpack_r16.c: Regenerate. ! * generated/unpack_r4.c: Regenerate. ! * generated/unpack_r8.c: Regenerate. ! ! 2009-03-24 Jerry DeLisle ! ! PR libfortran/39528 ! * io/list_read.c (list_formatted_read_scalar): Move check for read ! completion to just after the check for a repeated value. ! ! 2009-03-08 Jerry DeLisle ! ! PR libfortran/39402 ! * io/write_float.def (output_float): Handle F0.d formatting correctly ! for any d when value is 0.0. ! ! 2009-03-01 Ralf Wildenhues ! ! * configure: Regenerate. ! ! 2009-01-21 Daniel Kraft ! ! PR fortran/38887 ! * runtime/in_unpack_generic.c (internal_unpack): Return instead of ! abort when called with empty array. ! * m4/in_unpack.m4: Ditto. ! * generated/in_unpack_i1.c: Regenerated. ! * generated/in_unpack_i2.c: Regenerated. ! * generated/in_unpack_i4.c: Regenerated. ! * generated/in_unpack_i8.c: Regenerated. ! * generated/in_unpack_i16.c: Regenerated. ! * generated/in_unpack_r4.c: Regenerated. ! * generated/in_unpack_r8.c: Regenerated. ! * generated/in_unpack_r10.c: Regenerated. ! * generated/in_unpack_r16.c: Regenerated. ! * generated/in_unpack_c4.c: Regenerated. ! * generated/in_unpack_c8.c: Regenerated. ! * generated/in_unpack_c10.c: Regenerated. ! * generated/in_unpack_c16.c: Regenerated. ! ! 2009-01-12 Jerry DeLisle ! ! PR libfortran/38772 ! * io/read.c (read_f): Clean up loop conditions for BZ/BN, ! allowing proper digit testing. White space fix. ! ! 2009-01-05 Jerry DeLisle ! ! PR libfortran/38735 ! * io/unit.c (get_internal_unit): Set default BLANK= status to NULL for ! internal units. ! ! 2008-12-29 John David Anglin PR fortran/31832 * acinclude.m4 (LIBGFOR_CHECK_FOR_BROKEN_POWF): New autoconf check for *************** *** 13,24 **** * configure: Rebuilt. * config.h.in: Rebuilt. 2008-11-23 Thomas Koenig PR libfortran/38135 ! Backport from trunk. ! * m4/reshape.m4: Tread PAD as if it were SOURCE when SOURCE ! is empty. * intrinsics/reshape_generic.c: Likewise. * generated/reshape_c10.c Regenerated. * generated/reshape_c16.c Regenerated. --- 687,831 ---- * configure: Rebuilt. * config.h.in: Rebuilt. + 2008-12-22 Jerry DeLisle + + PR libfortran/37472 + * io/write_float.def (output_float_FMT_G_): Modify calculation of temp + to avoid sensitivity to round-off. + + 2008-12-21 Jerry DeLisle + + PR libfortran/38398 + * io/io.h (st_parameter_dt): Add new bit to keep track of when to + suppress blanks for g0 formatting. + * io/transfer.c (formatted_transfer_scalar): Always call write_real_g0 + for g0 formatting. + * io.c (write.c): Do not use ES formatting and use new bit to suppress + blanks. + * io/write_float.def (output_float): Adjust the location of setting the + width so that it can be adjusted when suppressing blanks. Set number of + blanks to zero when dtp->u.p.g0_no_blanks is set. Do some minor code + clean-up and add some white space for readability. + + 2008-12-18 Ralf Wildenhues + + * configure: Regenerate. + + 2008-12-13 Jerry DeLisle + + PR libfortran/38504 + io/write.c (write_decimal): Skip extra sign '-' at beginning of string + returned by gfc_itoa. + + 2008-12-08 Jerry DeLisle + + PR libfortran/38430 + * io/transfer.c (data_transfer_init): Move constraint check for REC= + and STREAM access into condition for other REC= constraints to simplify. + Comment out this constraint to avoid breaking compatibility with 4.3 + until later. Added a TODO for above comment and this one. + Fix test for max pos. + + 2008-12-06 Jerry DeLisle + + PR libfortran/38291 + * io/transfer.c (data_transfer_init): Add fbuf_flush inadvertently + ommitted. Add check for invalid use of REC= with ACCESS="stream". Fix + comment. + + 2008-12-06 Adam Nemet + + * runtime/main.c (store_exe_path): Don't crash if argv0 is NULL. + + 2008-12-05 Jerry DeLisle + + PR libfortran/38291 + * io/transfer.c (data_transfer_init): Add checks for POS= valid range. + Add check for unit opened with ACCESS="stream". Flush and seek if + current stream position does not match. Check ENDFILE on read. + + 2008-12-04 Jerry DeLisle + + PR fortran/38285 + * write_float.def (WRITE_FLOAT): Zero the float value for special case + only if scale_factor = 0. + 2008-11-23 Thomas Koenig + PR libfortran/38234 + * intrinsics/reshape_generic.c (reshape_internal): + Source can be larger than shape. + * m4/reshape.m4: Likewise. + * generated/reshape_c10.c Regenerated. + * generated/reshape_c16.c Regenerated. + * generated/reshape_c4.c Regenerated. + * generated/reshape_c8.c Regenerated. + * generated/reshape_i16.c Regenerated. + * generated/reshape_i4.c Regenerated. + * generated/reshape_i8.c Regenerated. + * generated/reshape_r10.c Regenerated. + * generated/reshape_r16.c Regenerated. + * generated/reshape_r4.c Regenerated. + * generated/reshape_r8.c Regenerated. + + 2008-11-22 Danny Smith + + * libgfortran.h (__mingw_snprintf): Declare with gnu_printf + format attribute. + + + 2008-11-22 Thomas Koenig + + PR libfortran/38225 + * intrinsics/reshape_generic.c (reshape_internal): + Use all dimensions of source for bounds checking. + * m4/reshape.m4: Likewise. + * generated/reshape_c10.c Regenerated. + * generated/reshape_c16.c Regenerated. + * generated/reshape_c4.c Regenerated. + * generated/reshape_c8.c Regenerated. + * generated/reshape_i16.c Regenerated. + * generated/reshape_i4.c Regenerated. + * generated/reshape_i8.c Regenerated. + * generated/reshape_r10.c Regenerated. + * generated/reshape_r16.c Regenerated. + * generated/reshape_r4.c Regenerated. + * generated/reshape_r8.c Regenerated. + + 2008-11-22 Jakub Jelinek + + PR libfortran/37839 + * io/io.h (IOPARM_INQUIRE_HAS_ROUND, IOPARM_INQUIRE_HAS_SIGN, + IOPARM_INQUIRE_HAS_PENDING): Adjust values. + (st_parameter_inquire): Reorder and fix types of round, sign and + pending fields. + (st_parameter_43, st_parameter_44): Removed. + (st_parameter_dt): Put back struct definition directly to u.p + declaration. Change type of u.p.size_used from gfc_offset to + GFC_IO_INT. Decrease back size of u.pad to 16 pointers and + 32 ints. Put id, pos, asynchronous, blank, decimal, delim, + pad, round and sign fields after the union. + * io/inquire.c (inquire_via_unit, inquire_via_filename): Only read + flags2 if it is defined. + * io/transfer.c (read_sf, read_block_form, write_block): Cast + additions to size_used to GFC_IO_INT instead of gfc_offset. + (data_transfer_init): Clear whole u.p struct. Adjust + for moving id, pos, asynchronous, blank, decimal, delim, pad, + round and sign fields from u.p directly into st_parameter_dt. + (finalize_transfer): Don't cast size_used to GFC_IO_INT. + * io/file_pos.c (st_endfile): Clear whole u.p struct. + + 2008-11-20 Jerry DeLisle + + PR libfortran/37472 + * io/write_float.def (output_float_FMT_G_): Adjust conversion of + G format specification to F format. + + 2008-11-18 Thomas Koenig + PR libfortran/38135 ! * m4/reshape.m4: Correct bounds checking when PAD is present. ! Treat PAD as if it were SOURCE when SOURCE is empty. * intrinsics/reshape_generic.c: Likewise. * generated/reshape_c10.c Regenerated. * generated/reshape_c16.c Regenerated. *************** *** 32,98 **** * generated/reshape_r4.c Regenerated. * generated/reshape_r8.c Regenerated. ! 2008-10-28 Jerry DeLisle PR libfortran/37707 - Backport from trunk. * io/list_read.c (read_character): Remove code to look ahead in namelist reads to descriminate non-delimited strings from namelist objects. * io/write.c (namelist_write): Delimit character strings with quote or apostrophe, defaulting to quote. 2008-10-19 Jerry DeLisle PR fortran/36582 - Backport from trunk. * io/list_read.c: If variable rank is zero, do not adjust the found namelist object pointer. ! 2008-07-01 Jerry DeLisle PR fortran/36538 ! Backport from trunk. ! * io/list_read.c (namelist_read): Add eat_separator to ! eliminate leading tabs. ! 2008-06-06 Release Manager ! * GCC 4.3.1 released. ! 2008-05-06 Thomas Koenig PR libfortran/35995 - PR libfortran/35990 - Backport from trunk. * m4/ifunction_logical.m4: If the extent of "array" is less than zero, set it to zero. Use an explicit flag for breaking out of the main loop to avoid, because --- 839,1918 ---- * generated/reshape_r4.c Regenerated. * generated/reshape_r8.c Regenerated. ! 2008-11-16 Jerry DeLisle ! ! PR libfortran/38097 ! * io/read.c (read_f): Initialize exponent. Fix comment. Set loop ! conditions for BZ/BN. ! * io/unit.c (get_internal_unit): Initialize flags.blank. ! * io/transfer.c (data_transfer_init): Fix whitespace. ! ! 2008-11-15 Jerry DeLisle ! ! PR libfortran/37294 ! * io/write.c (namelist_write_newline): Use array loop specification to ! advance to next internal array unit record. (namelist_write): Adjust to ! accomodate the internal array unit behavior. ! ! 2008-11-01 Dennis Wassel ! ! PR fortran/37159 ! * intrinsics/random.c: Added comment to adapt check.c, should ! kiss_size change. ! Few cosmetic changes to existing comments. ! ! 2008-10-22 Jerry DeLisle PR libfortran/37707 * io/list_read.c (read_character): Remove code to look ahead in namelist reads to descriminate non-delimited strings from namelist objects. * io/write.c (namelist_write): Delimit character strings with quote or apostrophe, defaulting to quote. + 2008-10-21 Thomas Koenig + + PR libfortran/34670 + * intrinsics/transpose_generic.c: Implement bounds checking. + * m4/transpose.m4: Likewise. + * generated/transpose_c8.c: Regenerated. + * generated/transpose_c16.c: Regenerated. + * generated/transpose_r10.c: Regenerated. + * generated/transpose_i8.c: Regenerated. + * generated/transpose_c10.c: Regenerated. + * generated/transpose_r4.c: Regenerated. + * generated/transpose_c4.c: Regenerated. + * generated/transpose_i16.c: Regenerated. + * generated/transpose_i4.c: Regenerated. + * generated/transpose_r8.c: Regenerated. + * generated/transpose_r16.c: Regenerated. + 2008-10-19 Jerry DeLisle ! ! * io/file_pos.c (unformatted_backspace): Normal case is ! GFC_CONVERT_NATIVE. ! * io/transfer.c (read_sf): Mark paths leading to generate_error() ! as unlikely. ! (readl_block_form): Likewise. ! (read_block_direct): Likewise. ! (write_block): Likewise. ! (write_buf): Likewise. ! (us_read): Likewise. Normal case is GFC_CONVERT_NATIVE. ! (next_record_w_unf): Mark paths leading to generate_error() ! as unlikely. ! ! 2008-10-16 Thomas Koenig ! ! PR libfortran/34670 ! * generated/spread_r4.c: Regenerated. ! ! 2008-10-15 Thomas Koenig ! ! PR libfortran/34670 ! * intrinsics/reshape_generic.c: Add bounds checking. ! * m4/reshape.m4: Likewise. ! * generated/reshape_c10.c: Regenerated. ! * generated/reshape_c16.c: Regenerated. ! * generated/reshape_c4.c: Regenerated. ! * generated/reshape_c8.c: Regenerated. ! * generated/reshape_i16.c: Regenerated. ! * generated/reshape_i4.c: Regenerated. ! * generated/reshape_i8.c: Regenerated. ! * generated/reshape_r10.c: Regenerated. ! * generated/reshape_r16.c: Regenerated. ! * generated/reshape_r4.c: Regenerated. ! * generated/reshape_r8.c: Regenerated. ! * generated/spread_r4.c: Regenerated. ! ! 2008-10-13 Jerry DeLisle ! ! PR libfortran/37753 ! * io/transfer.c (unformatted_read): CONVERT_NATIVE ! is the usual case. Check for kind==1 for non-byte-reversing ! operation. ! (unformatted_write): Likewise. ! ! 2008-10-08 Jerry DeLisle ! Steve Ellcey ! * configure: Regenerate for new libtool. ! * Makefile.in: Ditto. ! 2008-09-25 Jerry DeLisle ! ! * runtime/compile_options.c (init_compile_options): ! Sync flags with front end. ! ! 2008-09-22 Jerry DeLisle ! H. J. Lu ! ! * mk-sik-inc.sh: Make -Wunused-variable proof. ! * mk-srk-inc.sh: Make -Wunused-variable proof. ! ! 2008-09-10 Tobias Burnus ! ! * mk-kinds-h.sh: Make -Wunused-variable proof. ! ! 2008-09-07 Thomas Koenig ! ! PR fortran/37203 ! * intrinsics/reshape_generic.c: Add checking on ! out-of-bounds and duplicate values of order argument. ! * m4/reshape.m4: Likewise. ! * generated/reshape_c10.c: Regenerated. ! * generated/reshape_c16.c: Regenerated. ! * generated/reshape_c4.c: Regenerated. ! * generated/reshape_c8.c: Regenerated. ! * generated/reshape_i16.c: Regenerated. ! * generated/reshape_i4.c: Regenerated. ! * generated/reshape_i8.c: Regenerated. ! * generated/reshape_r10.c: Regenerated. ! * generated/reshape_r16.c: Regenerated. ! * generated/reshape_r4.c: Regenerated. ! * generated/reshape_r8.c: Regenerated. ! ! 2008-09-06 Tobias Burnus ! ! * libgfortran.h (likely,unlikely): New makros. ! (runtime_warning_at,__mingw_snprintf): Add __attribute__(format()). ! * m4/spread.m4 (spread_'rtype_code`): Use unlikely for bounds_check. ! * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Ditto. ! * m4/matmull.m4 (matmul_'rtype_code`): Ditto. ! * m4/ifunction_logical.m4 (name`'rtype_qual`_'atype_code): Ditto. ! * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): Ditto. ! * m4/matmul.m4 (matmul_'rtype_code`): Ditto. ! ! * generated/minval_r8.c: Regenerated. ! * generated/spread_r10.c: Regenerated. ! * generated/minloc1_16_r16.c: Regenerated. ! * generated/maxloc1_4_r8.c: Regenerated. ! * generated/sum_i8.c: Regenerated. ! * generated/any_l16.c: Regenerated. ! * generated/spread_i8.c: Regenerated. ! * generated/maxval_i2.c: Regenerated. ! * generated/any_l2.c: Regenerated. ! * generated/product_r4.c: Regenerated. ! * generated/maxloc1_8_i4.c: Regenerated. ! * generated/maxloc0_4_r4.c: Regenerated. ! * generated/all_l1.c: Regenerated. ! * generated/matmul_r8.c: Regenerated. ! * generated/product_i2.c: Regenerated. ! * generated/minloc0_4_r16.c: Regenerated. ! * generated/minloc0_4_i1.c: Regenerated. ! * generated/maxloc0_4_r16.c: Regenerated. ! * generated/maxloc0_4_i2.c: Regenerated. ! * generated/minloc1_8_r16.c: Regenerated. ! * generated/maxloc1_8_r16.c: Regenerated. ! * generated/maxloc0_8_i8.c: Regenerated. ! * generated/sum_r16.c: Regenerated. ! * generated/sum_i1.c: Regenerated. ! * generated/minloc1_4_r8.c: Regenerated. ! * generated/maxloc1_16_r16.c: Regenerated. ! * generated/minloc1_16_i4.c: Regenerated. ! * generated/maxloc1_16_i4.c: Regenerated. ! * generated/minloc0_16_i8.c: Regenerated. ! * generated/spread_i1.c: Regenerated. ! * generated/maxloc0_16_i8.c: Regenerated. ! * generated/maxval_r16.c: Regenerated. ! * generated/product_c10.c: Regenerated. ! * generated/minloc1_8_i4.c: Regenerated. ! * generated/minloc0_16_i16.c: Regenerated. ! * generated/matmul_r16.c: Regenerated. ! * generated/minloc0_4_r4.c: Regenerated. ! * generated/all_l2.c: Regenerated. ! * generated/product_c4.c: Regenerated. ! * generated/sum_r4.c: Regenerated. ! * generated/minloc0_4_i2.c: Regenerated. ! * generated/spread_c10.c: Regenerated. ! * generated/maxloc0_8_i1.c: Regenerated. ! * generated/spread_r4.c: Regenerated. ! * generated/minloc0_8_i8.c: Regenerated. ! * generated/matmul_c8.c: Regenerated. ! * generated/all_l16.c: Regenerated. ! * generated/minloc1_16_r10.c: Regenerated. ! * generated/sum_i2.c: Regenerated. ! * generated/minloc0_16_i1.c: Regenerated. ! * generated/maxloc0_16_i1.c: Regenerated. ! * generated/maxloc1_8_r8.c: Regenerated. ! * generated/minval_i16.c: Regenerated. ! * generated/spread_i2.c: Regenerated. ! * generated/maxval_i4.c: Regenerated. ! * generated/minval_i8.c: Regenerated. ! * generated/any_l4.c: Regenerated. ! * generated/maxloc1_4_i8.c: Regenerated. ! * generated/maxloc0_16_i16.c: Regenerated. ! * generated/maxloc0_8_r4.c: Regenerated. ! * generated/minloc1_4_i16.c: Regenerated. ! * generated/maxloc1_4_i16.c: Regenerated. ! * generated/minloc0_4_r10.c: Regenerated. ! * generated/minloc0_8_i16.c: Regenerated. ! * generated/maxloc0_4_r10.c: Regenerated. ! * generated/maxloc0_8_i16.c: Regenerated. ! * generated/minloc1_8_r10.c: Regenerated. ! * generated/product_i4.c: Regenerated. ! * generated/minloc0_16_r4.c: Regenerated. ! * generated/sum_c16.c: Regenerated. ! * generated/maxloc1_8_r10.c: Regenerated. ! * generated/maxloc0_16_r4.c: Regenerated. ! * generated/minloc1_16_r8.c: Regenerated. ! * generated/minloc0_8_i1.c: Regenerated. ! * generated/maxloc0_4_i4.c: Regenerated. ! * generated/maxloc1_16_r8.c: Regenerated. ! * generated/maxloc0_8_i2.c: Regenerated. ! * generated/sum_r10.c: Regenerated. ! * generated/count_4_l.c: Regenerated. ! * generated/sum_c4.c: Regenerated. ! * generated/count_8_l.c: Regenerated. ! * generated/maxloc1_16_r10.c: Regenerated. ! * generated/matmul_i8.c: Regenerated. ! * generated/minloc0_16_i2.c: Regenerated. ! * generated/minloc1_8_r8.c: Regenerated. ! * generated/maxloc0_16_i2.c: Regenerated. ! * generated/spread_c4.c: Regenerated. ! * generated/matmul_c16.c: Regenerated. ! * generated/maxval_r10.c: Regenerated. ! * generated/minval_i1.c: Regenerated. ! * generated/maxloc1_4_i1.c: Regenerated. ! * generated/matmul_r10.c: Regenerated. ! * generated/minloc1_4_i8.c: Regenerated. ! * generated/minloc0_8_r4.c: Regenerated. ! * generated/matmul_l4.c: Regenerated. ! * generated/product_i16.c: Regenerated. ! * generated/minloc0_16_r16.c: Regenerated. ! * generated/all_l4.c: Regenerated. ! * generated/minloc0_4_i4.c: Regenerated. ! * generated/minloc0_8_i2.c: Regenerated. ! * generated/matmul_i1.c: Regenerated. ! * generated/minval_r4.c: Regenerated. ! * generated/maxloc1_4_r4.c: Regenerated. ! * generated/spread_i16.c: Regenerated. ! * generated/sum_i4.c: Regenerated. ! * generated/maxval_r8.c: Regenerated. ! * generated/spread_i4.c: Regenerated. ! * generated/minloc1_4_i1.c: Regenerated. ! * generated/minval_r16.c: Regenerated. ! * generated/minval_i2.c: Regenerated. ! * generated/maxloc1_4_i2.c: Regenerated. ! * generated/product_r8.c: Regenerated. ! * generated/maxloc1_8_i8.c: Regenerated. ! * generated/maxloc0_4_r8.c: Regenerated. ! * generated/maxloc0_16_r16.c: Regenerated. ! * generated/matmul_r4.c: Regenerated. ! * generated/sum_c10.c: Regenerated. ! * generated/minloc1_4_r16.c: Regenerated. ! * generated/maxloc1_4_r16.c: Regenerated. ! * generated/minloc0_8_r16.c: Regenerated. ! * generated/maxloc0_8_r16.c: Regenerated. ! * generated/count_1_l.c: Regenerated. ! * generated/maxloc0_8_i4.c: Regenerated. ! * generated/matmul_i2.c: Regenerated. ! * generated/minloc1_4_r4.c: Regenerated. ! * generated/matmul_c10.c: Regenerated. ! * generated/minloc0_16_i4.c: Regenerated. ! * generated/maxloc0_16_i4.c: Regenerated. ! * generated/minloc1_16_i8.c: Regenerated. ! * generated/maxloc1_16_i8.c: Regenerated. ! * generated/minloc1_4_i2.c: Regenerated. ! * generated/matmul_l16.c: Regenerated. ! * generated/maxloc1_8_i1.c: Regenerated. ! * generated/minloc0_16_r10.c: Regenerated. ! * generated/minloc1_8_i8.c: Regenerated. ! * generated/minloc0_4_r8.c: Regenerated. ! * generated/product_r16.c: Regenerated. ! * generated/product_c8.c: Regenerated. ! * generated/sum_r8.c: Regenerated. ! * generated/minloc0_8_i4.c: Regenerated. ! * generated/matmul_c4.c: Regenerated. ! * generated/minloc1_16_i16.c: Regenerated. ! * generated/spread_r8.c: Regenerated. ! * generated/maxloc1_8_r4.c: Regenerated. ! * generated/minloc1_16_i1.c: Regenerated. ! * generated/maxloc1_16_i1.c: Regenerated. ! * generated/spread_r16.c: Regenerated. ! * generated/minval_r10.c: Regenerated. ! * generated/count_16_l.c: Regenerated. ! * generated/minval_i4.c: Regenerated. ! * generated/minloc1_8_i1.c: Regenerated. ! * generated/maxloc1_4_i4.c: Regenerated. ! * generated/maxloc1_8_i2.c: Regenerated. ! * generated/maxval_i8.c: Regenerated. ! * generated/any_l8.c: Regenerated. ! * generated/maxloc0_16_r10.c: Regenerated. ! * generated/minloc0_4_i16.c: Regenerated. ! * generated/maxloc0_8_r8.c: Regenerated. ! * generated/maxloc0_4_i16.c: Regenerated. ! * generated/minloc1_4_r10.c: Regenerated. ! * generated/minloc1_8_i16.c: Regenerated. ! * generated/maxloc1_4_r10.c: Regenerated. ! * generated/maxloc1_8_i16.c: Regenerated. ! * generated/minloc0_8_r10.c: Regenerated. ! * generated/maxloc0_8_r10.c: Regenerated. ! * generated/minloc1_16_r4.c: Regenerated. ! * generated/maxloc1_16_r4.c: Regenerated. ! * generated/minloc0_16_r8.c: Regenerated. ! * generated/product_i8.c: Regenerated. ! * generated/maxloc0_16_r8.c: Regenerated. ! * generated/sum_i16.c: Regenerated. ! * generated/count_2_l.c: Regenerated. ! * generated/maxloc0_4_i8.c: Regenerated. ! * generated/maxloc1_16_i16.c: Regenerated. ! * generated/matmul_i4.c: Regenerated. ! * generated/minloc1_8_r4.c: Regenerated. ! * generated/sum_c8.c: Regenerated. ! * generated/minloc1_16_i2.c: Regenerated. ! * generated/maxloc1_16_i2.c: Regenerated. ! * generated/maxval_i16.c: Regenerated. ! * generated/spread_c8.c: Regenerated. ! * generated/matmul_i16.c: Regenerated. ! * generated/minloc1_4_i4.c: Regenerated. ! * generated/maxval_i1.c: Regenerated. ! * generated/minloc1_8_i2.c: Regenerated. ! * generated/any_l1.c: Regenerated. ! * generated/product_c16.c: Regenerated. ! * generated/minloc0_8_r8.c: Regenerated. ! * generated/matmul_l8.c: Regenerated. ! * generated/product_r10.c: Regenerated. ! * generated/product_i1.c: Regenerated. ! * generated/all_l8.c: Regenerated. ! * generated/maxloc0_4_i1.c: Regenerated. ! * generated/minloc0_4_i8.c: Regenerated. ! * generated/spread_c16.c: Regenerated. ! * generated/maxval_r4.c: Regenerated. ! ! 2008-09-01 Jerry DeLisle ! ! PR libfortran/37301 ! PR libfortran/37228 ! * io/io.h (write_real_g0): Declare new function to handle g0.d format. ! * io/transfer.c (formatted_transfer_scalar): Use new function. ! * io/format.c (parse_format_list): Enable g0.d. ! * io/write.c (write_a_char4): Delete unused var. ! (set_fnode_default): New function to set the default fnode w, d, and e ! factored from write_real. (write_real): Use new factored function. ! (write_real_g0): New function that sets d to that passed by g0.d format ! specifier and set format to ES. Default values for w and e are used ! from the new function, set_fnode_default. ! ! 2008-09-01 Jerry DeLisle ! ! * runtime/error.c: Fix cast for printf. ! ! 2008-08-30 Jerry DeLisle ! ! PR libfortran/36895 ! * io/write.c (namelist_write_newline): New function to correctly mark ! next records in both external and internal units. ! (nml_write_obj): Use new function. ! (namelist_write: Use new function. ! ! 2008-08-19 Tobias Burnus ! ! PR libfortran/35863 ! * io/write.c (write_a_char4): Add missing variable declaration ! in HAVE_CRLF block. ! ! 2008-08-15 Jerry DeLisle ! ! PR libfortran/35863 ! * intrinsics/selected_char_kind.c: Enable iso_10646. ! * io/read.c (typedef uchar): New type. ! (read_utf8): New function to read a single UTF-8 encoded character. ! (read_utf8_char1): New function to read UTF-8 into a KIND=1 string. ! (read_default_char1): New functio to read default into KIND=1 string. ! (read_utf8_char4): New function to read UTF-8 into a KIND=4 string. ! (read_default_char4): New function to read UTF-8 into a KIND=4 string. ! (read_a): Modify to use the new functions. ! (read_a_char4): Modify to use the new functions. ! * io/write.c (error.h): Add include. (typedef uchar): New type. ! (write_default_char4): New function to default write KIND=4 string. ! (write_utf8_char4): New function to UTF-8 write KIND=4 string. ! (write_a_char4): Modify to use new functions. ! (write_character): Modify to use new functions. ! ! 2008-08-14 H.J. Lu ! ! PR libfortran/37123 ! * intrinsics/cshift0.c (cshift0): Fix 2 typos. ! ! 2008-08-14 Thomas Koenig ! ! PR libfortran/36886 ! * Makefile.am: Added $(i_cshift0_c). ! Added $(i_cshift0_c) to gfor_built_specific_src. ! Add rule to build from cshift0.m4. ! * Makefile.in: Regenerated. ! * libgfortran.h: Addedd prototypes for cshift0_i1, ! cshift0_i2, cshift0_i4, cshift0_i8, cshift0_i16, ! cshift0_r4, cshift0_r8, cshift0_r10, cshift0_r16, ! cshift0_c4, cshift0_c8, cshift0_c10, cshift0_c16. ! Define Macros GFC_UNALIGNED_C4 and GFC_UNALIGNED_C8. ! * intrinsics/cshift0.c: Remove helper functions for ! the innter shift loop. ! (cshift0): Call specific functions depending on type ! of array argument. Only call specific functions for ! correct alignment for other types. ! * m4/cshift0.m4: New file. ! * generated/cshift0_i1.c: New file. ! * generated/cshift0_i2.c: New file. ! * generated/cshift0_i4.c: New file. ! * generated/cshift0_i8:.c New file. ! * generated/cshift0_i16.c: New file. ! * generated/cshift0_r4.c: New file. ! * generated/cshift0_r8.c: New file. ! * generated/cshift0_r10.c: New file. ! * generated/cshift0_r16.c: New file. ! * generated/cshift0_c4.c: New file. ! * generated/cshift0_c8.c: New file. ! * generated/cshift0_c10.c: New file. ! * generated/cshift0_c16.c: New file. ! ! 2008-07-27 Tobias Burnus ! ! PR fortran/36132 ! PR fortran/29952 ! PR fortran/36909 ! * runtime/error.c: New function runtime_error_at. ! * gfortran.map: Ditto. ! * libgfortran.h: Ditto. ! ! 2008-07-22 Jerry DeLisle PR fortran/36582 * io/list_read.c: If variable rank is zero, do not adjust the found namelist object pointer. + + 2008-07-22 Daniel Kraft + + PR fortran/29835 + * io/format.c (struct format_data): New member error_element. + (unexpected_element): Added '%c' to message. + (next_char): Keep track of last parsed character in fmt->error_element. + (format_error): If the message is unexpected_element, output the + offending character, too. + + 2008-07-22 Thomas Koenig + + PR libfortran/36890 + * io/file_pos.c: Declare READ_CHUNK as signed to avoid + signed/unsigned comparison warning in formatted_backspace. + + 2008-07-21 Thomas Koenig + + PR libfortran/36773 + * intrinsics/cshift0.c (cshift0): Return early if size of array + is zero. + * intrinsics/eoshift0.c (eoshift0): Return early if size of + return array is zero. + * intrinsics/eoshift2.c (eoshift2): Likewise. + * m4/eoshift1.m4 (eoshift1): Return early if size of array + is zero. + * m4/eoshift3.m4 (eoshift3): Likewise. + * m4/eoshift2.m4 (eoshift2): Return early if size of return + array is zero. + * m4/eoshift4.m4 (eoshift2): Return early if size of return + array is zero. + * generated/cshift1_16.c: Regenerated. + * generated/cshift1_4.c: Regenerated. + * generated/cshift1_8.c: Regenerated. + * generated/eoshift1_16.c: Regenerated. + * generated/eoshift1_4.c: Regenerated. + * generated/eoshift1_8.c: Regenerated. + * generated/eoshift3_16.c: Regenerated. + * generated/eoshift3_4.c: Regenerated. + * generated/eoshift3_8.c: Regenerated. + + 2008-07-20 Jerry DeLisle + + PR fortran/36857 + * io/write_float.def: Comment out locale dependent code and fix general + comments. ! 2008-07-07 Thomas Koenig ! ! PR fortran/36341 ! PR fortran/34670 ! * m4/matmul.m4: Add bounds checking. ! * m4/matmull.m4: Likewise. ! * generated/matmul_c10.c: Regenerated. ! * generated/matmul_c16.c: Regenerated. ! * generated/matmul_c4.c: Regenerated. ! * generated/matmul_c8.c: Regenerated. ! * generated/matmul_i1.c: Regenerated. ! * generated/matmul_i16.c: Regenerated. ! * generated/matmul_i2.c: Regenerated. ! * generated/matmul_i4.c: Regenerated. ! * generated/matmul_i8.c: Regenerated. ! * generated/matmul_l16.c: Regenerated. ! * generated/matmul_l4.c: Regenerated. ! * generated/matmul_l8.c: Regenerated. ! * generated/matmul_r10.c: Regenerated. ! * generated/matmul_r16.c: Regenerated. ! * generated/matmul_r4.c: Regenerated. ! * generated/matmul_r8.c: Regenerated. ! ! 2008-07-07 Ralf Wildenhues ! ! * acinclude.m4 (LIBGFOR_CHECK_GTHR_DEFAULT): Fix configure cache ! variable name. ! * configure: Regenerate. ! ! 2008-07-01 Jerry DeLisle PR fortran/36676 + * io/list_read.c (find_nml_name): Use eat_separator instead of eat_line. + + 2008-06-28 Jerry DeLisle + PR fortran/36657 + * io/list_read.c (read_character): Check for '!' along with separators. + (find_nml_name): Likewise and eat the comment if found. + + 2008-06-17 Ralf Wildenhues + + * configure: Regenerate. + + 2008-06-16 Jerry DeLisle + PR fortran/36546 ! * io/list_read.c (eat_separator): Add tab character to condition ! for looping past whitespace. ! 2008-06-14 Jerry DeLisle + PR fortran/36515 + * libgfortran.h (compile_options_t): Add int range_check to structure. + * runtime/compile_options.c (set_options): Add range_check option. + (init_compile_options): Likewise. + *io/read.c (read_decimal): Change overflow checks to include + range_check. + + 2008-06-13 Jerry DeLisle + PR fortran/36538 ! * io/list_read.c (namelist_read): Add eat_separator to eliminate leading ! tabs. ! 2008-06-13 Jerry DeLisle ! PR fortran/35863 ! * libgfortran.h: Change l8_to_l4_offset to big_endian and add endian_off. ! * runtime/main.c: Fix error in comment. Change l8_to_l4_offset to ! big_endian. (determine_endianness): Add endian_off and set its value ! according to big_endian. ! * gfortran.map: Add symbol for new _gfortran_transfer_character_wide. ! * io/io.h: Add prototype declarations for new functions. ! * io/list_read.c (list_formatted_read_scalar): Modify to handle kind=4. ! (list_formatted_read): Calculate stride based on kind for character type ! and use it when calling list_formatted_read_scalar. ! * io/inquire.c (inquire_via_unit): Change l8_to_l4_offset to big_endian. ! * io/open.c (st_open): Change l8_to_l4_offset to big_endian. ! * io/read.c (read_a_char4): New function to handle formatted read. ! * io/write.c: Define GFC_CHAR4(x) to improve readability of code. ! (write_a_char4): New function to handle formatted write. ! (write_character): Modify to accept the kind parameter and adjust for ! endianess of the machine. (list_formatted_write): Calculate the stride ! resulting from the kind and adjust the list_formatted_write_scalar call ! accordingly. (nml_write_obj): Adjust calls to write_character. ! (namelist_write): Likewise. ! * io/transfer.c (formatted_transfer_scaler): Rename 'len' argument to ! 'kind' argument to better describe what it is. Add calls to new ! functions for kind == 4. (formatted_transfer): Modify to handle the case ! of type character and kind equals 4 to pass in the kind to the transfer ! routines. (transfer_character_wide): Add this new function. ! (transfer_array): Don't set kind to the character string length. Adjust ! strides bases on character kind. ! (unformatted_read): Adjust size based on kind for character types. ! (unformatted_write): Likewise. (data_transfer_init): Change ! l8_to_l4_offset to big_endian. ! io/fbuf.c (fbuf_seek): Add cast to eliminate warning. ! 2008-06-13 Tobias Burnus ! ! * configure.ac (AM_CFLAGS): Remove -Werror again. ! * configure: Regenerate. ! ! 2008-06-13 Tobias Burnus ! ! PR libgfortran/36518 ! * configure.ac (AM_CFLAGS): Add -Werror. ! * configure: Regenerate. ! * m4/ifunction_logical.m4: Cast "n" to "(int)". ! * generated/any_l16.c: Regenerate. ! * generated/any_l2.c: Regenerate. ! * generated/all_l1.c: Regenerate. ! * generated/all_l2.c: Regenerate. ! * generated/all_l16.c: Regenerate. ! * generated/any_l4.c: Regenerate. ! * generated/count_4_l.c: Regenerate. ! * generated/count_8_l.c: Regenerate. ! * generated/all_l4.c: Regenerate. ! * generated/count_1_l.c: Regenerate. ! * generated/count_16_l.c: Regenerate. ! * generated/any_l8.c: Regenerate. ! * generated/count_2_l.c: Regenerate. ! * generated/any_l1.c: Regenerate. ! * generated/all_l8.c: Regenerate. ! ! 2008-06-13 Tobias Burnus ! ! PR fortran/36495 ! * configure.ac (AM_FCFLAGS): Add "-Werror -fimplicit-none". ! * configure: (generated) ditto. ! * intrinsics/dprod_r8.f90: Add "implicit none". ! ! 2008-06-07 Jerry DeLisle ! ! PR libfortran/36420 ! PR libfortran/36421 ! PR libfortran/36422 ! * io/io.h: Add prototype for write_real. ! * io/transfer.c (formatted_transfer_scalar): For FMT_G and width zero, ! use write_real. ! * io/format.c: Add zero width error message. (parse_format_list): Use ! error message for FMT_A if followed by FMT_ZERO. Use zero width error ! message for FMT_G if mode is READ or if -std=f95 or f2003. (fmormat0): ! Fix typo in comment. ! * io/write.c(write_a): Set wlen to len if FMT_G and length is zero. ! (write_l): Add wlen variable and use it if FMT_G and width is zero. ! (write_decimal): If FMT_G, set m to -1 to flag processor dependent ! formatting. (write_real): Remove static declaration. ! ! 2008-05-28 Francois-Xavier Coudert ! ! PR fortran/36319 ! * intrinsics/string_intrinsics_inc.c (string_index): Return ! correct value for zero-length substring. ! * intrinsics/cshift0.c: Add _char4 variant. ! * intrinsics/eoshift0.c (eoshift0): Allow filler to be a pattern ! wider than a single byte. Add _char4 variant and use above ! functionality. ! * intrinsics/eoshift2.c (eoshift2): Likewise. ! * m4/eoshift1.m4: Likewise. ! * m4/eoshift3.m4: Likewise. ! * m4/cshift1.m4: Add _char4 variants. ! * gfortran.map (GFORTRAN_1.1): Add _gfortran_cshift0_1_char4, ! _gfortran_cshift0_2_char4, _gfortran_cshift0_4_char4, ! _gfortran_cshift0_8_char4, _gfortran_cshift1_16_char4, ! _gfortran_cshift1_4_char4, _gfortran_cshift1_8_char4, ! _gfortran_eoshift0_1_char4, _gfortran_eoshift0_2_char4, ! _gfortran_eoshift0_4_char4, _gfortran_eoshift0_8_char4, ! _gfortran_eoshift1_16_char4, _gfortran_eoshift1_4_char4, ! _gfortran_eoshift1_8_char4, _gfortran_eoshift2_1_char4, ! _gfortran_eoshift2_2_char4, _gfortran_eoshift2_4_char4, ! _gfortran_eoshift2_8_char4, _gfortran_eoshift3_16_char4, ! _gfortran_eoshift3_4_char4 and _gfortran_eoshift3_8_char4. ! * generated/eoshift3_4.c: Regenerate. ! * generated/eoshift1_8.c: Regenerate. ! * generated/eoshift1_16.c: Regenerate. ! * generated/cshift1_4.c: Regenerate. ! * generated/eoshift1_4.c: Regenerate. ! * generated/eoshift3_8.c: Regenerate. ! * generated/eoshift3_16.c: Regenerate. ! * generated/cshift1_8.c: Regenerate. ! * generated/cshift1_16.c: Regenerate. ! ! 2008-05-25 Tobias Burnus ! ! PR fortran/32600 ! * intrinsics/iso_c_binding.c (c_f_procpointer): Remove. ! * intrinsics/iso_c_binding.h (c_f_procpointer): Remove. ! * gfortran.map (c_f_procpointer): Remove. ! ! 2008-05-22 Thomas Koenig ! ! PR libgfortran/36302 ! * gfortran.map (GFORTRAN_1.1): Add _gfortran_eoshift0_16, ! _gfortran_eoshift0_16_char, _gfortran_eoshift2_16, ! _gfortran_eoshift2_16_char,_gfortran_cshift0_16, ! _gfortran_cshift0_16_char. Sort alphabetically. ! * intrinsics/eoshift0.c: Add function for kind=16 integer. ! * intrinsics/eoshift2.c: Likewise. ! * intrinsics/cshift0.c: Likewise. ! ! 2008-05-18 Thomas Koenig ! ! * m4/in_pack.m4 (internal_pack_'rtype_code`): Destination ! pointer is restrict. ! * m4/transpose.m4 (transpose_'rtype_code`): Likewise. ! * m4/pack.m4 (pack_'rtype_code`): Likewise. ! * m4/spread.m4 (spread_'rtype_code`): Likewise. ! (spread_scalar_'rtype_code`): Likewise. ! * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Likewise. ! * m4/eoshift1.m4 (eoshift1): Likewise. ! * m4/eoshift3.m4 (eoshift3): Likewise. ! * m4/in_unpack.m4 (internal_unpack_'rtype_ccode`): Likewise. ! * m4/unpack.m4 (unpack0_'rtype_code`): Likewise. ! (unpack1_'rtype_code`): Likewise. ! * intrinsics/pack_generic.c (pack_generic.c): Likewise. ! * intrinsics/unpack_generic.c (unpack_internal): Likewise. ! * intrinsics/eoshift0.c (eoshift0): Likewise. ! * intrinsics/eoshift2.c (eoshift2): Likewise. ! * intrinsics/reshape_generic.c (reshape_internal): Likewise. ! * intrinsics/reshape_packed.c (reshape_packed): Likewise. ! * generated/eoshift1_16.c: Regenerated. ! * generated/eoshift1_4.c: Regenerated. ! * generated/eoshift1_8.c: Regenerated. ! * generated/eoshift3_16.c: Regenerated. ! * generated/eoshift3_4.c: Regenerated. ! * generated/eoshift3_8.c: Regenerated. ! * generated/in_pack_c10.c: Regenerated. ! * generated/in_pack_c16.c: Regenerated. ! * generated/in_pack_c4.c: Regenerated. ! * generated/in_pack_c8.c: Regenerated. ! * generated/in_pack_i1.c: Regenerated. ! * generated/in_pack_i16.c: Regenerated. ! * generated/in_pack_i2.c: Regenerated. ! * generated/in_pack_i4.c: Regenerated. ! * generated/in_pack_i8.c: Regenerated. ! * generated/in_pack_r10.c: Regenerated. ! * generated/in_pack_r16.c: Regenerated. ! * generated/in_pack_r4.c: Regenerated. ! * generated/in_pack_r8.c: Regenerated. ! * generated/in_unpack_c10.c: Regenerated. ! * generated/in_unpack_c16.c: Regenerated. ! * generated/in_unpack_c4.c: Regenerated. ! * generated/in_unpack_c8.c: Regenerated. ! * generated/in_unpack_i1.c: Regenerated. ! * generated/in_unpack_i16.c: Regenerated. ! * generated/in_unpack_i2.c: Regenerated. ! * generated/in_unpack_i4.c: Regenerated. ! * generated/in_unpack_i8.c: Regenerated. ! * generated/in_unpack_r10.c: Regenerated. ! * generated/in_unpack_r16.c: Regenerated. ! * generated/in_unpack_r4.c: Regenerated. ! * generated/in_unpack_r8.c: Regenerated. ! * generated/maxloc0_16_i1.c: Regenerated. ! * generated/maxloc0_16_i16.c: Regenerated. ! * generated/maxloc0_16_i2.c: Regenerated. ! * generated/maxloc0_16_i4.c: Regenerated. ! * generated/maxloc0_16_i8.c: Regenerated. ! * generated/maxloc0_16_r10.c: Regenerated. ! * generated/maxloc0_16_r16.c: Regenerated. ! * generated/maxloc0_16_r4.c: Regenerated. ! * generated/maxloc0_16_r8.c: Regenerated. ! * generated/maxloc0_4_i1.c: Regenerated. ! * generated/maxloc0_4_i16.c: Regenerated. ! * generated/maxloc0_4_i2.c: Regenerated. ! * generated/maxloc0_4_i4.c: Regenerated. ! * generated/maxloc0_4_i8.c: Regenerated. ! * generated/maxloc0_4_r10.c: Regenerated. ! * generated/maxloc0_4_r16.c: Regenerated. ! * generated/maxloc0_4_r4.c: Regenerated. ! * generated/maxloc0_4_r8.c: Regenerated. ! * generated/maxloc0_8_i1.c: Regenerated. ! * generated/maxloc0_8_i16.c: Regenerated. ! * generated/maxloc0_8_i2.c: Regenerated. ! * generated/maxloc0_8_i4.c: Regenerated. ! * generated/maxloc0_8_i8.c: Regenerated. ! * generated/maxloc0_8_r10.c: Regenerated. ! * generated/maxloc0_8_r16.c: Regenerated. ! * generated/maxloc0_8_r4.c: Regenerated. ! * generated/maxloc0_8_r8.c: Regenerated. ! * generated/minloc0_16_i1.c: Regenerated. ! * generated/minloc0_16_i16.c: Regenerated. ! * generated/minloc0_16_i2.c: Regenerated. ! * generated/minloc0_16_i4.c: Regenerated. ! * generated/minloc0_16_i8.c: Regenerated. ! * generated/minloc0_16_r10.c: Regenerated. ! * generated/minloc0_16_r16.c: Regenerated. ! * generated/minloc0_16_r4.c: Regenerated. ! * generated/minloc0_16_r8.c: Regenerated. ! * generated/minloc0_4_i1.c: Regenerated. ! * generated/minloc0_4_i16.c: Regenerated. ! * generated/minloc0_4_i2.c: Regenerated. ! * generated/minloc0_4_i4.c: Regenerated. ! * generated/minloc0_4_i8.c: Regenerated. ! * generated/minloc0_4_r10.c: Regenerated. ! * generated/minloc0_4_r16.c: Regenerated. ! * generated/minloc0_4_r4.c: Regenerated. ! * generated/minloc0_4_r8.c: Regenerated. ! * generated/minloc0_8_i1.c: Regenerated. ! * generated/minloc0_8_i16.c: Regenerated. ! * generated/minloc0_8_i2.c: Regenerated. ! * generated/minloc0_8_i4.c: Regenerated. ! * generated/minloc0_8_i8.c: Regenerated. ! * generated/minloc0_8_r10.c: Regenerated. ! * generated/minloc0_8_r16.c: Regenerated. ! * generated/minloc0_8_r4.c: Regenerated. ! * generated/minloc0_8_r8.c: Regenerated. ! * generated/pack_c10.c: Regenerated. ! * generated/pack_c16.c: Regenerated. ! * generated/pack_c4.c: Regenerated. ! * generated/pack_c8.c: Regenerated. ! * generated/pack_i1.c: Regenerated. ! * generated/pack_i16.c: Regenerated. ! * generated/pack_i2.c: Regenerated. ! * generated/pack_i4.c: Regenerated. ! * generated/pack_i8.c: Regenerated. ! * generated/pack_r10.c: Regenerated. ! * generated/pack_r16.c: Regenerated. ! * generated/pack_r4.c: Regenerated. ! * generated/pack_r8.c: Regenerated. ! * generated/spread_c10.c: Regenerated. ! * generated/spread_c16.c: Regenerated. ! * generated/spread_c4.c: Regenerated. ! * generated/spread_c8.c: Regenerated. ! * generated/spread_i1.c: Regenerated. ! * generated/spread_i16.c: Regenerated. ! * generated/spread_i2.c: Regenerated. ! * generated/spread_i4.c: Regenerated. ! * generated/spread_i8.c: Regenerated. ! * generated/spread_r10.c: Regenerated. ! * generated/spread_r16.c: Regenerated. ! * generated/spread_r4.c: Regenerated. ! * generated/spread_r8.c: Regenerated. ! * generated/transpose_c10.c: Regenerated. ! * generated/transpose_c16.c: Regenerated. ! * generated/transpose_c4.c: Regenerated. ! * generated/transpose_c8.c: Regenerated. ! * generated/transpose_i16.c: Regenerated. ! * generated/transpose_i4.c: Regenerated. ! * generated/transpose_i8.c: Regenerated. ! * generated/transpose_r10.c: Regenerated. ! * generated/transpose_r16.c: Regenerated. ! * generated/transpose_r4.c: Regenerated. ! * generated/transpose_r8.c: Regenerated. ! * generated/unpack_c10.c: Regenerated. ! * generated/unpack_c16.c: Regenerated. ! * generated/unpack_c4.c: Regenerated. ! * generated/unpack_c8.c: Regenerated. ! * generated/unpack_i1.c: Regenerated. ! * generated/unpack_i16.c: Regenerated. ! * generated/unpack_i2.c: Regenerated. ! * generated/unpack_i4.c: Regenerated. ! * generated/unpack_i8.c: Regenerated. ! * generated/unpack_r10.c: Regenerated. ! * generated/unpack_r16.c: Regenerated. ! * generated/unpack_r4.c: Regenerated. ! * generated/unpack_r8.c: Regenerated. ! ! 2008-05-18 Francois-Xavier Coudert ! ! * runtime/select.c: Moved content to select_inc.c. Include it. ! Add macros for different character types. ! * runtime/select_inc.c: New file. ! * runtime/convert_char.c: New file. ! * intrinsics/pack_generic.c (pack_char4, pack_s_char4): New ! functions. ! * intrinsics/transpose_generic.c (transpose_char4): New function. ! * intrinsics/spread_generic.c (spread_char4, spread_char4_scalar): ! New functions. ! * intrinsics/unpack_generic.c (unpack1_char4, unpack0_char4): ! New functions. ! * intrinsics/reshape_generic.c (reshape_char): Use ! gfc_charlen_type as type for length variables. ! (reshape_char4): New function. ! * gfortran.map (GFORTRAN_1.1): Add _gfortran_select_string_char4, ! _gfortran_convert_char1_to_char4, _gfortran_convert_char4_to_char1, ! _gfortran_transpose_char4, _gfortran_spread_char4, ! _gfortran_spread_char4_scalar, _gfortran_reshape_char4, ! _gfortran_pack_char4, _gfortran_pack_s_char4, ! _gfortran_unpack0_char4 and _gfortran_unpack1_char4. ! * Makefile.am: Add runtime/convert_char.c. ! * Makefile.in: Regenerate. ! ! 2008-05-17 Thomas Koenig ! ! * io/list_read.c (list_formatted_read_scalar): Declare ! type as volatile to shut up compiler warning. ! ! 2008-05-16 Janne Blomqvist ! ! PR libfortran/25561 ! * io/io.h (struct fbuf): Change pointer to position offset. ! * io/fbuf.c (fbuf_init): Reduce default size of buffer, ptr=>pos ! changes. ! (fbuf_reset): ptr=>pos changes. ! (fbuf_alloc): If the request doesn't fit, don't waste memory by ! keeping flushed bytes. ptr=>pos changes. ! (fbuf_flush): ptr=>pos changes. ! (fbuf_seek): Don't seek past the left tab limit, don't update active ! byte count. ! * io/open.c (new_unit): If RECL has been specified, used that as ! initial buffer size. ! ! 2008-05-16 Janne Blomqvist ! ! PR libfortran/35632 ! * io/open.c (new_unit): Set stream position to correct value. ! ! 2008-05-15 Janne Blomqvist ! ! PR libfortran/25561 ! * Makefile.am: Add fbuf.c to gfor_io_src. ! * Makefile.in: Regenerate. ! * io/io.h (read_block): Remove. ! (struct stream): Remove alloc_r_at function pointer. ! (salloc_r): Remove. ! (salloc_r_at): Remove. ! (salloc_w_at): Remove. ! (salloc_w): Remove offset argument. ! (struct fbuf): New struct for format buffer. ! (struct gfc_unit): Add fbuf. ! (read_block_form): New prototype. ! (fbuf_init): Likewise. ! (fbuf_destroy): Likewise. ! (fbuf_reset): Likewise. ! (fbuf_alloc): Likewise. ! (fbuf_flush): Likewise. ! (fbuf_seek): Likewise. ! * io/file_pos.c (formatted_backspace): Change to use sread. ! (unformatted_backspace): Likewise. ! (st_backspace): Flush format buffer. ! (st_rewind): Likewise. ! * io/list_read.c (next_char): Likewise. ! (nml_query): Tidying, flush format buffer. ! * io/open.c (new_unit): Init format buffer. ! * io/read.c (read_l): Change to use read_block_form. ! (read_a): Likewise. ! (read_decimal): Likewise. ! (read_radix): Likewise. ! (read_f): Likewise. ! (read_x): Empty reads also for stream I/O. ! * io/transfer.c (read_sf): Change to use sread. ! (read_block): Rename to read_block_form, change prototype, use sread. ! (read_block_direct): Don't seek stream files. ! (write_block): Change to use fbuf if external file, don't seek stream ! files. ! (write_buf): Don't seek stream files. ! (formatted_transfer_scalar): Use fbuf for external files. ! (us_read): Change to use sread. ! (pre_position): Do nothing for stream I/O. ! (data_transfer_init): Flush fbuf when switching from write to read, if ! POS is specified, seek stream file to correct offset. ! (skip_record): Change to use sread. ! (min_off): New function. ! (next_record_r): Change to use sread. ! (next_record_w): Change to use sset/sseek, flush fbuf. ! (finalize_transfer): Flush fbuf. ! * io/unit.c (init_units): Init fbuf for stdout, stderr. ! (close_unit_1): Destroy fbuf. ! (finish_last_advance_record): Flush fbuf, no need to seek. ! * io/unix.c (fd_alloc_r_at): Remove unused where argument. ! (fd_alloc_w_at): Likewise. ! (fd_read): Remove third argument to fd_alloc_r_at. ! (fd_write): Remove third argument to fd_alloc_w_at. ! (fd_sset): Likewise. ! (fd_open): Don't set alloc_r_at. ! (mem_alloc_r_at): Remove unused where argument. ! (mem_alloc_w_at): Likewise. ! (mem_read): Don't incorrectly return previous errno, remove unused ! third argument to alloc function. ! (mem_write): Likewise. ! (mem_set): Likewise. ! (open_internal): Don't set alloc_r_at pointer. ! * io/fbuf.c: New file. ! ! 2008-05-14 Francois-Xavier Coudert ! ! * libgfortran.h (gfc_char4_t): New type. ! (GFC_SIZE_OF_CHAR_KIND): New macro. ! (compare_string): Adjust prototype. ! (compare_string_char4): New prototype. ! * gfortran.map (GFORTRAN_1.1): Add _gfortran_adjustl_char4, ! _gfortran_adjustr_char4, _gfortran_compare_string_char4, ! _gfortran_concat_string_char4, _gfortran_string_index_char4, ! _gfortran_string_len_trim_char4, _gfortran_string_minmax_char4, ! _gfortran_string_scan_char4, _gfortran_string_trim_char4 and ! _gfortran_string_verify_char4. ! * intrinsics/string_intrinsics_inc.c: New file from content of ! string_intrinsics.c with types replaced by macros. ! * intrinsics/string_intrinsics.c: Move content to ! string_intrinsics_inc.c. ! ! 2008-05-11 Jerry DeLisle ! ! PR libfortran/36202 ! * io/list_read (eat_separator): Handle the CR-LF case correctly. ! ! 2008-05-09 Julian Brown ! ! * Makefile.am (LTLDFLAGS): New. ! (libgfortran_la_LDFLAGS): Use above. ! * Makefile.in: Regenerate. ! ! 2008-05-05 Jerry DeLisle ! ! PR libfortran/36131 ! * io/transfer.c (formatted_transfer_scalar): Revert patch for PR34974. ! (next_record_w): Likewise. ! ! 2008-05-04 Thomas Koenig PR libfortran/35995 * m4/ifunction_logical.m4: If the extent of "array" is less than zero, set it to zero. Use an explicit flag for breaking out of the main loop to avoid, because *************** *** 212,217 **** --- 2032,2046 ---- * generated/sum_r16.c: Regenerated. * generated/sum_r4.c: Regenerated. * generated/sum_r8.c: Regenerated. + + 2008-05-04 Thomas Koenig + + PR libfortran/35990 + * intrinsics/pack_generic.c: Really commit. + + 2008-05-04 Thomas Koenig + + PR libfortran/35990 * intrinsics/pack_generic.c: If an extent of the source array is less then zero, set it to zero. Set the source pointer to NULL if the source size is zero. Set the total *************** *** 235,244 **** * generated/pack_c10.c: Regenerated. * generated/pack_c16.c: Regenerated. ! 2008-05-03 Thomas Koenig PR libfortran/35993 - Backport from trunk. * ifunction.m4 (SCALAR_ARRAY_FUNCTION): Use correct implementation for multi-dimensional return arrays when the mask is .false. --- 2064,2086 ---- * generated/pack_c10.c: Regenerated. * generated/pack_c16.c: Regenerated. ! 2008-05-01 Jerry DeLisle ! ! PR libfortran/36094 ! * runtime/error.c (show_locus): Provide modified error message when ! filename has not yet been associated with a unit number. ! * io/open.c (encoding_opt[]): Comment out "utf-8" option and add TODO. ! ! 2008-04-30 Francois-Xavier Coudert ! ! * intrinsics/selected_char_kind.c: New file. ! * gfortran.map (GFORTRAN_1.1): Add _gfortran_selected_char_kind. ! * Makefile.am: Add intrinsics/selected_char_kind.c. ! * Makefile.in: Regenerate. ! ! 2008-04-30 Thomas Koenig PR libfortran/35993 * ifunction.m4 (SCALAR_ARRAY_FUNCTION): Use correct implementation for multi-dimensional return arrays when the mask is .false. *************** *** 341,346 **** --- 2183,2310 ---- * generated/sum_r4.c: Regenerated. * generated/sum_r8.c: Regenerated. + 2008-04-25 Thomas Koenig + + PR libfortran/35960 + * m4/reshape.m4: Fix typo in last commit. + * generated/reshape_i4.c: Regererated. + * generated/reshape_i8.c: Regenerated. + * generated/reshape_i16.c: Regenerated. + * generated/reshape_r4.c: Regenerated. + * generated/reshape_r8.c: Regenerated. + * generated/reshape_r10.c: Regenerated. + * generated/reshape_r16.c: Regenerated. + * generated/reshape_c4.c: Regenerated. + * generated/reshape_c8.c: Regenerated. + * generated/reshape_c10.c: Regenerated. + * generated/reshape_c16.c: Regenerated. + + 2008-04-24 Francois-Xavier Coudert + + * intrinsics/time_1.h (__time_1): Remove unused variable. + + 2008-04-23 Thomas Koenig + + PR libfortran/35988 + * m4/matmul.m4: Only issue a runtime error if extents are + non-zero. + * generated/matmul_i1.c: Regenerated. + * generated/matmul_i2.c: Regenerated. + * generated/matmul_i4.c: Regenerated. + * generated/matmul_i8.c: Regenerated. + * generated/matmul_i16.c: Regenerated. + * generated/matmul_r4.c: Regenerated. + * generated/matmul_r8.c: Regenerated. + * generated/matmul_r10.c: Regenerated. + * generated/matmul_r16.c: Regenerated. + * generated/matmul_c4.c: Regenerated. + * generated/matmul_c8.c: Regenerated. + * generated/matmul_c10.c: Regenerated. + * generated/matmul_c16.c: Regenerated. + + 2008-04-21 Ralf Wildenhues + + * acinclude.m4 (LIBGFOR_CHECK_ATTRIBUTE_VISIBILITY) + (LIBGFOR_CHECK_ATTRIBUTE_DLLEXPORT) + (LIBGFOR_CHECK_ATTRIBUTE_ALIAS, LIBGFOR_CHECK_SYNC_FETCH_AND_ADD) + (LIBGFOR_GTHREAD_WEAK, LIBGFOR_CHECK_UNLINK_OPEN_FILE) + (LIBGFOR_CHECK_CRLF, LIBGFOR_CHECK_FOR_BROKEN_ISFINITE) + (LIBGFOR_CHECK_FOR_BROKEN_ISNAN) + (LIBGFOR_CHECK_FOR_BROKEN_FPCLASSIFY, LIBGFOR_CHECK_WORKING_STAT) + (LIBGFOR_CHECK_FPSETMASK, LIBGFOR_CHECK_MINGW_SNPRINTF): + Fix cache variable names. + * configure, Makefile.in: Regenerate. + + 2008-04-20 Jerry DeLisle + + PR fortran/35991 + * intrinsics/cshift0.c (cshift0): Avoid divide by zero. + + 2008-04-20 Thomas Koenig + + PR libfortran/35960 + * intrinsics/reshape_generic.c (reshape_internal): If the size + of the resized array is zero, as determined by the SHAPE + argument, return early. + * m4/reshape.m4: Likewise. + * generated/reshape_i4.c: Regererated. + * generated/reshape_i8.c: Regenerated. + * generated/reshape_i16.c: Regenerated. + * generated/reshape_r4.c: Regenerated. + * generated/reshape_r8.c: Regenerated. + * generated/reshape_r10.c: Regenerated. + * generated/reshape_r16.c: Regenerated. + * generated/reshape_c4.c: Regenerated. + * generated/reshape_c8.c: Regenerated. + * generated/reshape_c10.c: Regenerated. + * generated/reshape_c16.c: Regenerated. + + 2008-04-18 Paolo Bonzini + + PR bootstrap/35457 + * aclocal.m4: Regenerate. + * configure: Regenerate. + + 2008-04-14 Thomas Koenig + + PR libfortran/32972 + * intrinsics/spread_generic.c (spread): Use spread_i2() + for GFC_DTYPE_DERIVED_2 (fix typo from previous commit). + + 2008-04-13 Thomas Koenig + Francois-Xavier Coudert + + PR libfortran/32972 + PR libfortran/32512 + configure.ac: Add test for uintptr_t. + configure: Regenerated. + config.h.in: Regenerated. + * libgfortran.h: GFC_DTYPE_DERIVED_1: New macro. + GFC_DTYPE_DERIVED_2: New macro. + GFC_DTYPE_DERIVED_4: New macro. + GFC_DTYPE_DERIVED_8: New macro. + GFC_DTYPE_DERIVED_16: New macro. + GFC_UNALIGNED_2: New macro. + GFC_UNALIGNED_4: New macro. + GFC_UNALIGNED_8: New macro. + GFC_UNALIGNED_16: New macro. + intptr_t: Define if we don't have it. + uintptr_t: Likewise. + * runtime/backtrace.c (show_backtrace): Use intptr_t. + * intrinsics/signal.c (signal_sub): Likewise. + (signal_sub_int): Likewise. + (alarm_sub_int_i4): Likewise. + * intrinsics/spread_generic.c (spread): Use the integer + routines for handling derived types of sizes 1, 2, 4, 8 and 16 + if the alignment of all pointers is correct. + (spread_scalar): Likewise. + * intrinsics/pack_generic.c (pack): Likewise. + Use GFD_DTYPE_TYPE_SIZE to avoid nested switch statements. + * intrinsics/unpack_generic.c (unpack1): Likewise. + (unpack0): Likewise. + * runtime/in_pack_generic.c (internal_pack): Likewise. + * runtime/in_unpack_generic.c (internal_unpack): Likewise. + 2008-04-09 Jakub Jelinek * io/list_read.c (snprintf): Define if HAVE_SNPRINTF isn't defined. *************** *** 355,360 **** --- 2319,2419 ---- (namelist_read): Increase size of nml_err_msg array to 200. Pass sizeof nml_err_msg as extra argument to nml_get_obj_data. + 2008-04-07 Jerry DeLisle + + PR fortran/25829 28655 + * io/open.c (edit_modes): Set flags.async. (new_unit) Set flags.async + and flags.status. (st_open): Initialize flags.async. + * io/list_read.c (read_charactor): Use delim_status instead of + flags.delim. + * io/read.c (read_x): Use pad_status instead of flags.pad. + * io/inquire.c (inquire_via_unit): Add new checks. + (inquire_via_filename): Likewise. + * io/io.h (st_parameter_inquire): Add new flags. + (st_parameter_dt): Likewise. + * io/unit.c (get_internal_unit): Set flags.async. (init_units): Set + flags.async. + * io/transfer.c: Add delim and pad option arrays. (read_sf): Use + pad_status instead of flags.pad. (read_block): Likewise. + (data_transfer_init): Set flags.async and add checks. + * io/write.c (write_character): Use delim_status. + (list_formatted_write_scalar): Likewise. (nml_write_obj): Likewise. + (namelist_write): Likewise. + + 2008-04-05 Jerry DeLisle + + PR fortran/25829 28655 + * gfortran.map: Add new symbol, _gfortran_st_wait. + * libgfortran.h (st_paramter_common): Add new I/O parameters. + * open.c (st_option decimal_opt[], st_option encoding_opt[], + st_option round_opt[], st_option sign_opt[], st_option async_opt[]): New + parameter option arrays. (edit_modes): Add checks for new parameters. + (new_unit): Likewise. (st_open): Likewise. + * list_read.c (CASE_SEPERATORS): Add ';' as a valid separator. + (eat_separator): Handle deimal comma. (read_logical): Fix whitespace. + (parse_real): Handle decimal comma. (read_real): Handle decimal comma. + * read.c (read_a): Use decimal status flag to allow comma in place of a + decimal point. (read_f): Allow comma as acceptable character in float. + According to decimal flag, substitute a period for a comma. + (read_x): If decimal status flag is comma, disable the read_comma flag, + not allowing comma as a delimiter, an extension otherwise. + * io.h: (unit_decimal, unit_encoding, unit_round, unit_sign, + unit_async): New enumerators. Add all new I/O parameters. + * unix.c (unix_stream, int_stream): Add io_mode asychronous I/O control. + (move_pos_offset, fd_alloc_w_at): Fix some whitespace. + (fd_sfree): Use new enumerator. (fd_read): Likewise. + (fd_write): Likewise. (fd_close): Fix whitespace. + (fd_open): Use new enumertors. (tempfile, regular_file, + open_external): Fix whitespace. (output_stream, error_stream): Set + method. (stream_offset): Fix whitespace. + * transfer.c: (st_option decimal_opt[], sign_opt[], blank_opt[]): New + option arrays. (formatted_transfer_scalar): Set sf_read_comma flag + based on new decimal_status flag. (data_transfer_init): Initialize new + parameters. Add checks for decimal, sign, and blank. (st_wait): New stub. + * format.c: (format_lex): Add format specifiers DP, DC, and D. + (parse_format_list): Parse the new specifiers. + * write.c (write_decimal): Use new sign enumerators to set the sign. + (write_complex): Handle decimal comma and semi-colon separator. + (nml_write_obj): Likewise. + * write_float.def: Revise sign enumerators. (calculate_sign): Use new + sign enumerators. (output_float): Likewise. Use new decimal_status flag + to set the decimal character to a point or a comma. + + 2008-03-28 Thomas Koenig + + PR libfortran/32972 + PR libfortran/32512 + * Makefile.am: Add new variable, i_spread_c, containing + pack_i1.c, pack_i2.c, pack_i4.c, pack_i8.c, spread_i16.c, + spread_r4.c, spread_r8.c, spread_r10.c, spread_r16.c, + spread_c4.c, spread_c8.c, spread_c10.c, spread_c16.c. + * Makefile.in: Regenerated. + * libgfortran.h: Add prototypes for spread_i1, spread_i2, + spread_i4, spread_i8, spread_i16, spread_r4, spread_r8, + spread_c4, spread_c8, spread_c10, spread_c16, + spread_scalar_i1, spread_scalar_i2, spread_scalar_i4, + spread_scalar_i8, spread_scalar_i16, spread_scalar_r4 + spread_scalar_r8, spread_scalar_c4, spread_scalar_c8, + spread_scalar_c10 and spread_scalar_c16. + Add macros to isolate both type and size information + from array descriptors with a single mask operation. + * intrinsics/spread_generic.c: Add calls to specific + spread functions. + * m4/spread.m4: New file. + * generated/spread_i1.c: New file. + * generated/spread_i2.c: New file. + * generated/spread_i4.c: New file. + * generated/spread_i8.c: New file. + * generated/spread_i16.c: New file. + * generated/spread_r4.c: New file. + * generated/spread_r8.c: New file. + * generated/spread_r10.c: New file. + * generated/spread_r16.c: New file. + * generated/spread_c4.c: New file. + * generated/spread_c8.c: New file. + * generated/spread_c10.c: New file. + * generated/spread_c16.c: New file. + 2008-03-28 Jerry DeLisle PR libfortran/35699 *************** *** 362,371 **** data is NULL. (next_record_w): If there are bytes left in the record for unformatted direct I/O, pad out the record with zero bytes. ! 2008-03-20 Jerry DeLisle PR libfortran/35627 - Backport from trunk. * io/list_read.c (free_line): Clear the line buffer enable flag and reset the index into line_buffer, aka item_count. (next_char): Cleanup whitespace. --- 2421,2527 ---- data is NULL. (next_record_w): If there are bytes left in the record for unformatted direct I/O, pad out the record with zero bytes. ! 2008-03-28 Tobias Burnus ! ! PR fortran/35721 ! * intrinsics/associated.c (associated): Ignore different ! stride of pointer vs. target if only one element is referred. ! ! 2008-03-26 Jerry DeLisle ! ! * io/unix.c (fd_close): Do not close STDIN. ! ! 2007-03-23 Thomas Koenig ! ! PR libfortran/35632 ! * io/transfer.c (data_transfer_init): Fix whitespace. ! (next_record_w): Truncate the file only if the stream ! position is short of the file end. ! ! 2008-03-21 Jerry DeLisle ! ! * intrinsics/pack_generic.c: Fix typo. ! ! 2008-03-21 Janne Blomqvist ! ! * gfortran.map: Move erfc_scaled symbols to new symbol node ! GFORTRAN_1.1, thereby fixing ABI bug introduced in r132846. ! ! 2008-03-21 Thomas Koenig ! ! PR libfortran/32972 ! * runtime/in_pack_generic.c (internal_pack): Call correct ! function, pack_i16, for GFC_INTEGER_16. ! ! 2008-03-21 Thomas Koenig ! ! PR libfortran/32972 ! * Makefile.am: Add new variable, i_pack_c, containing ! pack_i1.c, pack_i2.c, pack_i4.c, pack_i8.c, pack_i16.c, ! pack_r4.c, pack_r8.c, pack_r10.c, pack_r16.c, pack_c4.c, ! pack_c8.c, pack_c10.c, pack_c16.c. ! Add m4/pack.m4 to m4_files. ! Add i_pack_c to gfor_built_src. ! Add rule to generate i_pack_c from m4/pack.m4. ! * Makefile.in: Regenerated. ! * libgfortran.h: Add prototypes for pack_i1, pack_i2, pack_i4, ! pack_i8, pack_i16, pack_r4, pack_r8, pack_c4, pack_c8, ! pack_c10, pack_c16. ! * intrinsics/pack_generic.c: Add calls to specific ! pack functions. ! * m4/pack.m4: New file. ! * generated/pack_i1.c: New file. ! * generated/pack_i2.c: New file. ! * generated/pack_i4.c: New file. ! * generated/pack_i8.c: New file. ! * generated/pack_i16.c: New file. ! * generated/pack_r4.c: New file. ! * generated/pack_r8.c: New file. ! * generated/pack_r10.c: New file. ! * generated/pack_r16.c: New file. ! * generated/pack_c4.c: New file. ! * generated/pack_c8.c: New file. ! * generated/pack_c10.c: New file. ! * generated/pack_c16.c: New file. ! ! 2008-03-19 Jerry DeLisle PR libfortran/35627 * io/list_read.c (free_line): Clear the line buffer enable flag and reset the index into line_buffer, aka item_count. (next_char): Cleanup whitespace. *************** *** 374,387 **** clearing of index and flag that is now in free_line. (read_real): Likewise. PR libfortran/35617 - Backport from trunk. * io/list_read.c (eat_separator): If next character after eatline is '!' then eatline again. ! 2008-03-05 Release Manager ! * GCC 4.3.0 released. 2008-03-01 Francois-Xavier Coudert --- 2530,2628 ---- clearing of index and flag that is now in free_line. (read_real): Likewise. + 2008-03-19 Thomas Koenig + + PR libfortran/32972 + * runtime/in_pack_generic.c (internal_pack): Fix typo in + last commit. + + 2008-03-19 Thomas Koenig + + PR libfortran/32972 + * Makefile.am (in_pack_c): Add in_pack_i1.c, in_pack_i2.c, + in_pack_r4.c, in_pack_r8.c, in_pack_r10.c and in_pack_r16.c. + (in_unpack_c): Add in_unpack_i1.c, in_unpack_i2.c, + in_unpack_r4.c, in_unpack_r8.c, in_unpack_r10.c and + in_unpack_r16.c. + * Makefile.in: Regenerate. + * libgfortran.h: Add prototypes for internal_pack_1, + internal_pack_2, internal_pack_16, internal_pack_r4, + internal_pack_r8, internal_pack_r10, internal_pack_r16, + internal_pack_c10 and internal_pack_c16. Add prototypes for + internal_unpack_1, internal_unpack_2, internal_unpack_16, + internal_unpack_r4, internal_unpack_r8, internal_unpack_r10, + internal_unpack_r16, internal_unpack_c10 and + internal_unpack_c16. + * runtime/in_pack_generic.c (internal_pack): Use sizeof instead + of hardwired sizes. + Add calls to internal_pack_1, internal_pack_2, + internal_pack_16, internal_pack_r4, internal_pack_r8, + internal_pack_r10, internal_pack_r16, internal_pack_c10 and + internal_pack_c16. + * runtime/in_unpack_generic.c (internal_unpack): Use sizeof + instead of hardwired sizes. + Add calls to internal_unpack_1, internal_unpack_2, + internal_unpack_16, internal_unpack_r4, internal_unpack_r8, + internal_unpack_r10, internal_unpack_r16, internal_unpack_c10 + and internal_unpack_c16. + * generated/in_pack_r4.c: New file. + * generated/in_pack_i2.c: New file. + * generated/in_unpack_i1.c: New file. + * generated/in_pack_r10.c: New file. + * generated/in_unpack_r4.c: New file. + * generated/in_unpack_i2.c: New file. + * generated/in_unpack_r16.c: New file. + * generated/in_pack_r8.c: New file. + * generated/in_unpack_r10.c: New file. + * generated/in_unpack_r8.c: New file. + * generated/in_pack_r16.c: New file. + * generated/in_pack_i1.c: New file. + + 2008-03-17 Jerry DeLisle + PR libfortran/35617 * io/list_read.c (eat_separator): If next character after eatline is '!' then eatline again. ! 2008-03-16 Ralf Wildenhues ! * aclocal.m4: Regenerate. ! * configure: Likewise. ! * Makefile.in: Likewise. ! ! 2008-03-12 Francois-Xavier Coudert ! ! PR libfortran/35524 ! * intrinsics/erfc_scaled_inc.c: Only define the long double ! variant of erfc_scaled if expl is available. ! ! 2008-03-11 Francois-Xavier Coudert ! ! PR libfortran/32812 ! * intrinsics/random.c (scramble_seed, unscramble_seed): New ! functions. ! (random_seed_i4): Scramble the seed the user gives us before ! storing it, and unscramble it when we return it back later. ! ! 2008-03-05 Hans-Peter Nilsson ! ! PR libfortran/35293 ! * io/unix.c (fd_truncate): Fold s->special_file case into ! success case of ftruncate/chsize call instead of the failure case. ! Make failure case actually return failure. Properly update stream ! pointers on failure. Call runtime_error for targets without ! neither ftruncate nor chsize where such a call would be needed. ! ! 2008-03-03 Francois-Xavier Coudert ! ! PR fortran/33197 ! * intrinsics/erfc_scaled_inc.c: New file. ! * intrinsics/erfc_scaled.c: New file. ! * gfortran.map (GFORTRAN_1.0): Add _gfortran_erfc_scaled_r*. ! * Makefile.am: Add intrinsics/erfc_scaled.c. ! * config.h.in: Regenerate. ! * configure: Regenerate. ! * Makefile.in: Regenerate. 2008-03-01 Francois-Xavier Coudert *************** *** 389,394 **** --- 2630,2693 ---- * intrinsics/time_1.h (__time_1): Fix calculation of user_usec for mingw. + 2008-03-01 Janne Blomqvist + + PR libfortran/35063 + * io/unit.c (destroy_unit_mutex): Call __gthread_mutex_destroy + instead of macro kludge. + + 2008-02-25 Janne Blomqvist + + PR fortran/29549 + * Makefile.am: Add -fcx-fortran-rules to AM_CFLAGS for all of + libgfortran. + * Makefile.in: Regenerated. + + 2008-02-25 Francois-Xavier Coudert + + * m4/ifunction_logical.m4: Add casts to get rid of warnings. + * generated/all_l1.c: Regenerate. + * generated/all_l2.c: Regenerate. + * generated/all_l4.c: Regenerate. + * generated/all_l8.c: Regenerate. + * generated/all_l16.c: Regenerate. + * generated/any_l1.c: Regenerate. + * generated/any_l2.c: Regenerate. + * generated/any_l4.c: Regenerate. + * generated/any_l8.c: Regenerate. + * generated/any_l16.c: Regenerate. + * generated/count_1_l.c: Regenerate. + * generated/count_2_l.c: Regenerate. + * generated/count_4_l.c: Regenerate. + * generated/count_8_l.c: Regenerate. + * generated/count_16_l.c: Regenerate. + + 2008-02-24 Francois-Xavier Coudert + + PR libfortran/32841 + * acinclude.m4: Don't use HAVE_MATH_H. + * configure: Regenerate. + + 2008-02-20 Jerry DeLisle + + PR libfortran/35132 + * io/transfer.c (next_record_w): Truncate after the last record for + STREAM I/O. + + PR libfortran/34954 + * io/transfer.c (data_transfer_init): Initialize dtp->rec if writing. + + PR libfortran/34974 + * io/transfer.c (formatted_transfer_scalar): Flush the buffer if skips + is less than zero. (next_record_w): Use sseek to position the file to + the max position reached. + + 2008-02-20 Jerry DeLisle + + PR libfortran/35036 + * write_float.def (output_float): Add error checks for zero digits + after decimal point in E and D format specifiers. + 2008-02-10 Jerry DeLisle PR libfortran/35063 diff -Nrcpad gcc-4.3.3/libgfortran/Makefile.am gcc-4.4.0/libgfortran/Makefile.am *** gcc-4.3.3/libgfortran/Makefile.am Tue Jan 15 21:22:07 2008 --- gcc-4.4.0/libgfortran/Makefile.am Thu Aug 14 18:31:32 2008 *************** else *** 13,21 **** version_arg = endif toolexeclib_LTLIBRARIES = libgfortran.la libgfortran_la_LINK = $(LINK) ! libgfortran_la_LDFLAGS = -version-info `grep -v '^\#' $(srcdir)/libtool-version` -lm $(extra_ldflags_libgfortran) $(version_arg) myexeclib_LTLIBRARIES = libgfortranbegin.la myexeclibdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR) --- 13,23 ---- version_arg = endif + LTLDFLAGS = $(shell $(SHELL) $(top_srcdir)/../libtool-ldflags $(LDFLAGS)) + toolexeclib_LTLIBRARIES = libgfortran.la libgfortran_la_LINK = $(LINK) ! libgfortran_la_LDFLAGS = -version-info `grep -v '^\#' $(srcdir)/libtool-version` $(LTLDFLAGS) -lm $(extra_ldflags_libgfortran) $(version_arg) myexeclib_LTLIBRARIES = libgfortranbegin.la myexeclibdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR) *************** AM_CPPFLAGS = -iquote$(srcdir)/io -I$(sr *** 28,33 **** --- 30,38 ---- -I$(srcdir)/$(MULTISRCTOP)../gcc/config \ -I$(MULTIBUILDTOP)../../$(host_subdir)/gcc -D_GNU_SOURCE + # Fortran rules for complex multiplication and division + AM_CFLAGS += -fcx-fortran-rules + gfor_io_src= \ io/close.c \ io/file_pos.c \ *************** io/size_from_kind.c \ *** 42,48 **** io/transfer.c \ io/unit.c \ io/unix.c \ ! io/write.c gfor_io_headers= \ io/io.h --- 47,54 ---- io/transfer.c \ io/unit.c \ io/unix.c \ ! io/write.c \ ! io/fbuf.c gfor_io_headers= \ io/io.h *************** intrinsics/dtime.c \ *** 64,69 **** --- 70,76 ---- intrinsics/env.c \ intrinsics/eoshift0.c \ intrinsics/eoshift2.c \ + intrinsics/erfc_scaled.c \ intrinsics/etime.c \ intrinsics/exit.c \ intrinsics/fnum.c \ *************** intrinsics/mvbits.c \ *** 83,88 **** --- 90,96 ---- intrinsics/move_alloc.c \ intrinsics/pack_generic.c \ intrinsics/perror.c \ + intrinsics/selected_char_kind.c \ intrinsics/signal.c \ intrinsics/size.c \ intrinsics/sleep.c \ *************** runtime/in_unpack_generic.c *** 110,115 **** --- 118,124 ---- gfor_src= \ runtime/backtrace.c \ runtime/compile_options.c \ + runtime/convert_char.c \ runtime/environ.c \ runtime/error.c \ runtime/fpu.c \ *************** $(srcdir)/generated/eoshift3_4.c \ *** 370,393 **** --- 379,430 ---- $(srcdir)/generated/eoshift3_8.c \ $(srcdir)/generated/eoshift3_16.c + i_cshift0_c= \ + $(srcdir)/generated/cshift0_i1.c \ + $(srcdir)/generated/cshift0_i2.c \ + $(srcdir)/generated/cshift0_i4.c \ + $(srcdir)/generated/cshift0_i8.c \ + $(srcdir)/generated/cshift0_i16.c \ + $(srcdir)/generated/cshift0_r4.c \ + $(srcdir)/generated/cshift0_r8.c \ + $(srcdir)/generated/cshift0_r10.c \ + $(srcdir)/generated/cshift0_r16.c \ + $(srcdir)/generated/cshift0_c4.c \ + $(srcdir)/generated/cshift0_c8.c \ + $(srcdir)/generated/cshift0_c10.c \ + $(srcdir)/generated/cshift0_c16.c + + i_cshift1_c= \ $(srcdir)/generated/cshift1_4.c \ $(srcdir)/generated/cshift1_8.c \ $(srcdir)/generated/cshift1_16.c in_pack_c = \ + $(srcdir)/generated/in_pack_i1.c \ + $(srcdir)/generated/in_pack_i2.c \ $(srcdir)/generated/in_pack_i4.c \ $(srcdir)/generated/in_pack_i8.c \ $(srcdir)/generated/in_pack_i16.c \ + $(srcdir)/generated/in_pack_r4.c \ + $(srcdir)/generated/in_pack_r8.c \ + $(srcdir)/generated/in_pack_r10.c \ + $(srcdir)/generated/in_pack_r16.c \ $(srcdir)/generated/in_pack_c4.c \ $(srcdir)/generated/in_pack_c8.c \ $(srcdir)/generated/in_pack_c10.c \ $(srcdir)/generated/in_pack_c16.c in_unpack_c = \ + $(srcdir)/generated/in_unpack_i1.c \ + $(srcdir)/generated/in_unpack_i2.c \ $(srcdir)/generated/in_unpack_i4.c \ $(srcdir)/generated/in_unpack_i8.c \ $(srcdir)/generated/in_unpack_i16.c \ + $(srcdir)/generated/in_unpack_r4.c \ + $(srcdir)/generated/in_unpack_r8.c \ + $(srcdir)/generated/in_unpack_r10.c \ + $(srcdir)/generated/in_unpack_r16.c \ $(srcdir)/generated/in_unpack_c4.c \ $(srcdir)/generated/in_unpack_c8.c \ $(srcdir)/generated/in_unpack_c10.c \ *************** $(srcdir)/generated/pow_c8_i16.c \ *** 460,465 **** --- 497,547 ---- $(srcdir)/generated/pow_c10_i16.c \ $(srcdir)/generated/pow_c16_i16.c + i_pack_c = \ + $(srcdir)/generated/pack_i1.c \ + $(srcdir)/generated/pack_i2.c \ + $(srcdir)/generated/pack_i4.c \ + $(srcdir)/generated/pack_i8.c \ + $(srcdir)/generated/pack_i16.c \ + $(srcdir)/generated/pack_r4.c \ + $(srcdir)/generated/pack_r8.c \ + $(srcdir)/generated/pack_r10.c \ + $(srcdir)/generated/pack_r16.c \ + $(srcdir)/generated/pack_c4.c \ + $(srcdir)/generated/pack_c8.c \ + $(srcdir)/generated/pack_c10.c \ + $(srcdir)/generated/pack_c16.c + + i_unpack_c = \ + $(srcdir)/generated/unpack_i1.c \ + $(srcdir)/generated/unpack_i2.c \ + $(srcdir)/generated/unpack_i4.c \ + $(srcdir)/generated/unpack_i8.c \ + $(srcdir)/generated/unpack_i16.c \ + $(srcdir)/generated/unpack_r4.c \ + $(srcdir)/generated/unpack_r8.c \ + $(srcdir)/generated/unpack_r10.c \ + $(srcdir)/generated/unpack_r16.c \ + $(srcdir)/generated/unpack_c4.c \ + $(srcdir)/generated/unpack_c8.c \ + $(srcdir)/generated/unpack_c10.c \ + $(srcdir)/generated/unpack_c16.c + + i_spread_c = \ + $(srcdir)/generated/spread_i1.c \ + $(srcdir)/generated/spread_i2.c \ + $(srcdir)/generated/spread_i4.c \ + $(srcdir)/generated/spread_i8.c \ + $(srcdir)/generated/spread_i16.c \ + $(srcdir)/generated/spread_r4.c \ + $(srcdir)/generated/spread_r8.c \ + $(srcdir)/generated/spread_r10.c \ + $(srcdir)/generated/spread_r16.c \ + $(srcdir)/generated/spread_c4.c \ + $(srcdir)/generated/spread_c8.c \ + $(srcdir)/generated/spread_c10.c \ + $(srcdir)/generated/spread_c16.c + m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \ m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \ m4/minloc0.m4 m4/minloc1.m4 m4/minval.m4 m4/product.m4 m4/sum.m4 \ *************** m4_files= m4/iparm.m4 m4/ifunction.m4 m4 *** 468,474 **** m4/specific.m4 m4/specific2.m4 m4/head.m4 m4/shape.m4 m4/reshape.m4 \ m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \ m4/fraction.m4 m4/nearest.m4 m4/set_exponent.m4 m4/pow.m4 \ ! m4/misc_specifics.m4 m4/rrspacing.m4 m4/spacing.m4 gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \ $(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \ --- 550,557 ---- m4/specific.m4 m4/specific2.m4 m4/head.m4 m4/shape.m4 m4/reshape.m4 \ m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \ m4/fraction.m4 m4/nearest.m4 m4/set_exponent.m4 m4/pow.m4 \ ! m4/misc_specifics.m4 m4/rrspacing.m4 m4/spacing.m4 m4/pack.m4 \ ! m4/unpack.m4 m4/spread.m4 gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \ $(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \ *************** gfor_built_src= $(i_all_c) $(i_any_c) $( *** 476,484 **** $(i_matmul_c) $(i_matmull_c) $(i_transpose_c) $(i_shape_c) $(i_eoshift1_c) \ $(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \ $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \ ! $(i_pow_c) $(i_rrspacing_c) $(i_spacing_c) \ ! selected_int_kind.inc selected_real_kind.inc kinds.h \ ! kinds.inc c99_protos.inc fpu-target.h # Machine generated specifics gfor_built_specific_src= \ --- 559,567 ---- $(i_matmul_c) $(i_matmull_c) $(i_transpose_c) $(i_shape_c) $(i_eoshift1_c) \ $(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \ $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \ ! $(i_pow_c) $(i_rrspacing_c) $(i_spacing_c) $(i_pack_c) $(i_unpack_c) \ ! $(i_spread_c) selected_int_kind.inc selected_real_kind.inc kinds.h \ ! $(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h # Machine generated specifics gfor_built_specific_src= \ *************** $(i_eoshift1_c): m4/eoshift1.m4 $(I_M4_D *** 762,767 **** --- 845,853 ---- $(i_eoshift3_c): m4/eoshift3.m4 $(I_M4_DEPS) $(M4) -Dfile=$@ -I$(srcdir)/m4 eoshift3.m4 > $@ + $(i_cshift0_c): m4/cshift0.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 cshift0.m4 > $@ + $(i_cshift1_c): m4/cshift1.m4 $(I_M4_DEPS) $(M4) -Dfile=$@ -I$(srcdir)/m4 cshift1.m4 > $@ *************** $(i_set_exponent_c): m4/set_exponent.m4 *** 792,797 **** --- 878,892 ---- $(i_pow_c): m4/pow.m4 $(I_M4_DEPS) $(M4) -Dfile=$@ -I$(srcdir)/m4 pow.m4 > $@ + $(i_pack_c): m4/pack.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 pack.m4 > $@ + + $(i_unpack_c): m4/unpack.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 unpack.m4 > $@ + + $(i_spread_c): m4/spread.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 spread.m4 > $@ + $(gfor_built_specific_src): m4/specific.m4 m4/head.m4 $(M4) -Dfile=$@ -I$(srcdir)/m4 specific.m4 > $@ diff -Nrcpad gcc-4.3.3/libgfortran/Makefile.in gcc-4.4.0/libgfortran/Makefile.in *** gcc-4.3.3/libgfortran/Makefile.in Sat Jan 24 10:32:29 2009 --- gcc-4.4.0/libgfortran/Makefile.in Tue Apr 21 09:08:08 2009 *************** ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 *** 51,56 **** --- 51,58 ---- am__aclocal_m4_deps = $(top_srcdir)/../config/depstand.m4 \ $(top_srcdir)/../config/lead-dot.m4 \ $(top_srcdir)/../config/multi.m4 \ + $(top_srcdir)/../config/override.m4 \ + $(top_srcdir)/../config/proginstall.m4 \ $(top_srcdir)/../config/stdint.m4 \ $(top_srcdir)/../ltoptions.m4 $(top_srcdir)/../ltsugar.m4 \ $(top_srcdir)/../ltversion.m4 $(top_srcdir)/../lt~obsolete.m4 \ *************** toolexeclibLTLIBRARIES_INSTALL = $(INSTA *** 77,91 **** LTLIBRARIES = $(myexeclib_LTLIBRARIES) $(toolexeclib_LTLIBRARIES) libgfortran_la_LIBADD = am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \ ! runtime/compile_options.c runtime/environ.c runtime/error.c \ ! runtime/fpu.c runtime/main.c runtime/memory.c runtime/pause.c \ ! runtime/stop.c runtime/string.c runtime/select.c \ ! $(srcdir)/generated/all_l1.c $(srcdir)/generated/all_l2.c \ ! $(srcdir)/generated/all_l4.c $(srcdir)/generated/all_l8.c \ ! $(srcdir)/generated/all_l16.c $(srcdir)/generated/any_l1.c \ ! $(srcdir)/generated/any_l2.c $(srcdir)/generated/any_l4.c \ ! $(srcdir)/generated/any_l8.c $(srcdir)/generated/any_l16.c \ ! $(srcdir)/generated/count_1_l.c \ $(srcdir)/generated/count_2_l.c \ $(srcdir)/generated/count_4_l.c \ $(srcdir)/generated/count_8_l.c \ --- 79,93 ---- LTLIBRARIES = $(myexeclib_LTLIBRARIES) $(toolexeclib_LTLIBRARIES) libgfortran_la_LIBADD = am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \ ! runtime/compile_options.c runtime/convert_char.c \ ! runtime/environ.c runtime/error.c runtime/fpu.c runtime/main.c \ ! runtime/memory.c runtime/pause.c runtime/stop.c \ ! runtime/string.c runtime/select.c $(srcdir)/generated/all_l1.c \ ! $(srcdir)/generated/all_l2.c $(srcdir)/generated/all_l4.c \ ! $(srcdir)/generated/all_l8.c $(srcdir)/generated/all_l16.c \ ! $(srcdir)/generated/any_l1.c $(srcdir)/generated/any_l2.c \ ! $(srcdir)/generated/any_l4.c $(srcdir)/generated/any_l8.c \ ! $(srcdir)/generated/any_l16.c $(srcdir)/generated/count_1_l.c \ $(srcdir)/generated/count_2_l.c \ $(srcdir)/generated/count_4_l.c \ $(srcdir)/generated/count_8_l.c \ *************** am__libgfortran_la_SOURCES_DIST = runtim *** 284,299 **** --- 286,313 ---- $(srcdir)/generated/reshape_c8.c \ $(srcdir)/generated/reshape_c10.c \ $(srcdir)/generated/reshape_c16.c \ + $(srcdir)/generated/in_pack_i1.c \ + $(srcdir)/generated/in_pack_i2.c \ $(srcdir)/generated/in_pack_i4.c \ $(srcdir)/generated/in_pack_i8.c \ $(srcdir)/generated/in_pack_i16.c \ + $(srcdir)/generated/in_pack_r4.c \ + $(srcdir)/generated/in_pack_r8.c \ + $(srcdir)/generated/in_pack_r10.c \ + $(srcdir)/generated/in_pack_r16.c \ $(srcdir)/generated/in_pack_c4.c \ $(srcdir)/generated/in_pack_c8.c \ $(srcdir)/generated/in_pack_c10.c \ $(srcdir)/generated/in_pack_c16.c \ + $(srcdir)/generated/in_unpack_i1.c \ + $(srcdir)/generated/in_unpack_i2.c \ $(srcdir)/generated/in_unpack_i4.c \ $(srcdir)/generated/in_unpack_i8.c \ $(srcdir)/generated/in_unpack_i16.c \ + $(srcdir)/generated/in_unpack_r4.c \ + $(srcdir)/generated/in_unpack_r8.c \ + $(srcdir)/generated/in_unpack_r10.c \ + $(srcdir)/generated/in_unpack_r16.c \ $(srcdir)/generated/in_unpack_c4.c \ $(srcdir)/generated/in_unpack_c8.c \ $(srcdir)/generated/in_unpack_c10.c \ *************** am__libgfortran_la_SOURCES_DIST = runtim *** 350,375 **** $(srcdir)/generated/spacing_r4.c \ $(srcdir)/generated/spacing_r8.c \ $(srcdir)/generated/spacing_r10.c \ ! $(srcdir)/generated/spacing_r16.c selected_int_kind.inc \ ! selected_real_kind.inc kinds.h kinds.inc c99_protos.inc \ fpu-target.h io/close.c io/file_pos.c io/format.c io/inquire.c \ io/intrinsics.c io/list_read.c io/lock.c io/open.c io/read.c \ io/size_from_kind.c io/transfer.c io/unit.c io/unix.c \ ! io/write.c intrinsics/associated.c intrinsics/abort.c \ ! intrinsics/access.c intrinsics/args.c \ intrinsics/c99_functions.c intrinsics/chdir.c \ intrinsics/chmod.c intrinsics/clock.c intrinsics/cpu_time.c \ intrinsics/cshift0.c intrinsics/ctime.c \ intrinsics/date_and_time.c intrinsics/dtime.c intrinsics/env.c \ ! intrinsics/eoshift0.c intrinsics/eoshift2.c intrinsics/etime.c \ ! intrinsics/exit.c intrinsics/fnum.c intrinsics/gerror.c \ ! intrinsics/getcwd.c intrinsics/getlog.c intrinsics/getXid.c \ ! intrinsics/hostnm.c intrinsics/ierrno.c intrinsics/ishftc.c \ intrinsics/iso_c_generated_procs.c intrinsics/iso_c_binding.c \ intrinsics/kill.c intrinsics/link.c intrinsics/malloc.c \ intrinsics/mvbits.c intrinsics/move_alloc.c \ intrinsics/pack_generic.c intrinsics/perror.c \ ! intrinsics/signal.c intrinsics/size.c intrinsics/sleep.c \ intrinsics/spread_generic.c intrinsics/string_intrinsics.c \ intrinsics/system.c intrinsics/rand.c intrinsics/random.c \ intrinsics/rename.c intrinsics/reshape_generic.c \ --- 364,436 ---- $(srcdir)/generated/spacing_r4.c \ $(srcdir)/generated/spacing_r8.c \ $(srcdir)/generated/spacing_r10.c \ ! $(srcdir)/generated/spacing_r16.c \ ! $(srcdir)/generated/pack_i1.c $(srcdir)/generated/pack_i2.c \ ! $(srcdir)/generated/pack_i4.c $(srcdir)/generated/pack_i8.c \ ! $(srcdir)/generated/pack_i16.c $(srcdir)/generated/pack_r4.c \ ! $(srcdir)/generated/pack_r8.c $(srcdir)/generated/pack_r10.c \ ! $(srcdir)/generated/pack_r16.c $(srcdir)/generated/pack_c4.c \ ! $(srcdir)/generated/pack_c8.c $(srcdir)/generated/pack_c10.c \ ! $(srcdir)/generated/pack_c16.c $(srcdir)/generated/unpack_i1.c \ ! $(srcdir)/generated/unpack_i2.c \ ! $(srcdir)/generated/unpack_i4.c \ ! $(srcdir)/generated/unpack_i8.c \ ! $(srcdir)/generated/unpack_i16.c \ ! $(srcdir)/generated/unpack_r4.c \ ! $(srcdir)/generated/unpack_r8.c \ ! $(srcdir)/generated/unpack_r10.c \ ! $(srcdir)/generated/unpack_r16.c \ ! $(srcdir)/generated/unpack_c4.c \ ! $(srcdir)/generated/unpack_c8.c \ ! $(srcdir)/generated/unpack_c10.c \ ! $(srcdir)/generated/unpack_c16.c \ ! $(srcdir)/generated/spread_i1.c \ ! $(srcdir)/generated/spread_i2.c \ ! $(srcdir)/generated/spread_i4.c \ ! $(srcdir)/generated/spread_i8.c \ ! $(srcdir)/generated/spread_i16.c \ ! $(srcdir)/generated/spread_r4.c \ ! $(srcdir)/generated/spread_r8.c \ ! $(srcdir)/generated/spread_r10.c \ ! $(srcdir)/generated/spread_r16.c \ ! $(srcdir)/generated/spread_c4.c \ ! $(srcdir)/generated/spread_c8.c \ ! $(srcdir)/generated/spread_c10.c \ ! $(srcdir)/generated/spread_c16.c selected_int_kind.inc \ ! selected_real_kind.inc kinds.h \ ! $(srcdir)/generated/cshift0_i1.c \ ! $(srcdir)/generated/cshift0_i2.c \ ! $(srcdir)/generated/cshift0_i4.c \ ! $(srcdir)/generated/cshift0_i8.c \ ! $(srcdir)/generated/cshift0_i16.c \ ! $(srcdir)/generated/cshift0_r4.c \ ! $(srcdir)/generated/cshift0_r8.c \ ! $(srcdir)/generated/cshift0_r10.c \ ! $(srcdir)/generated/cshift0_r16.c \ ! $(srcdir)/generated/cshift0_c4.c \ ! $(srcdir)/generated/cshift0_c8.c \ ! $(srcdir)/generated/cshift0_c10.c \ ! $(srcdir)/generated/cshift0_c16.c kinds.inc c99_protos.inc \ fpu-target.h io/close.c io/file_pos.c io/format.c io/inquire.c \ io/intrinsics.c io/list_read.c io/lock.c io/open.c io/read.c \ io/size_from_kind.c io/transfer.c io/unit.c io/unix.c \ ! io/write.c io/fbuf.c intrinsics/associated.c \ ! intrinsics/abort.c intrinsics/access.c intrinsics/args.c \ intrinsics/c99_functions.c intrinsics/chdir.c \ intrinsics/chmod.c intrinsics/clock.c intrinsics/cpu_time.c \ intrinsics/cshift0.c intrinsics/ctime.c \ intrinsics/date_and_time.c intrinsics/dtime.c intrinsics/env.c \ ! intrinsics/eoshift0.c intrinsics/eoshift2.c \ ! intrinsics/erfc_scaled.c intrinsics/etime.c intrinsics/exit.c \ ! intrinsics/fnum.c intrinsics/gerror.c intrinsics/getcwd.c \ ! intrinsics/getlog.c intrinsics/getXid.c intrinsics/hostnm.c \ ! intrinsics/ierrno.c intrinsics/ishftc.c \ intrinsics/iso_c_generated_procs.c intrinsics/iso_c_binding.c \ intrinsics/kill.c intrinsics/link.c intrinsics/malloc.c \ intrinsics/mvbits.c intrinsics/move_alloc.c \ intrinsics/pack_generic.c intrinsics/perror.c \ ! intrinsics/selected_char_kind.c intrinsics/signal.c \ ! intrinsics/size.c intrinsics/sleep.c \ intrinsics/spread_generic.c intrinsics/string_intrinsics.c \ intrinsics/system.c intrinsics/rand.c intrinsics/random.c \ intrinsics/rename.c intrinsics/reshape_generic.c \ *************** am__libgfortran_la_SOURCES_DIST = runtim *** 519,526 **** $(srcdir)/generated/misc_specifics.F90 intrinsics/dprod_r8.f90 \ intrinsics/f2c_specifics.F90 libgfortran_c.c $(filter-out \ %.c,$(prereq_SRC)) ! am__objects_1 = backtrace.lo compile_options.lo environ.lo error.lo \ ! fpu.lo main.lo memory.lo pause.lo stop.lo string.lo select.lo am__objects_2 = all_l1.lo all_l2.lo all_l4.lo all_l8.lo all_l16.lo am__objects_3 = any_l1.lo any_l2.lo any_l4.lo any_l8.lo any_l16.lo am__objects_4 = count_1_l.lo count_2_l.lo count_4_l.lo count_8_l.lo \ --- 580,588 ---- $(srcdir)/generated/misc_specifics.F90 intrinsics/dprod_r8.f90 \ intrinsics/f2c_specifics.F90 libgfortran_c.c $(filter-out \ %.c,$(prereq_SRC)) ! am__objects_1 = backtrace.lo compile_options.lo convert_char.lo \ ! environ.lo error.lo fpu.lo main.lo memory.lo pause.lo stop.lo \ ! string.lo select.lo am__objects_2 = all_l1.lo all_l2.lo all_l4.lo all_l8.lo all_l16.lo am__objects_3 = any_l1.lo any_l2.lo any_l4.lo any_l8.lo any_l16.lo am__objects_4 = count_1_l.lo count_2_l.lo count_4_l.lo count_8_l.lo \ *************** am__objects_19 = cshift1_4.lo cshift1_8. *** 590,598 **** am__objects_20 = reshape_i4.lo reshape_i8.lo reshape_i16.lo \ reshape_r4.lo reshape_r8.lo reshape_r10.lo reshape_r16.lo \ reshape_c4.lo reshape_c8.lo reshape_c10.lo reshape_c16.lo ! am__objects_21 = in_pack_i4.lo in_pack_i8.lo in_pack_i16.lo \ ! in_pack_c4.lo in_pack_c8.lo in_pack_c10.lo in_pack_c16.lo ! am__objects_22 = in_unpack_i4.lo in_unpack_i8.lo in_unpack_i16.lo \ in_unpack_c4.lo in_unpack_c8.lo in_unpack_c10.lo \ in_unpack_c16.lo am__objects_23 = exponent_r4.lo exponent_r8.lo exponent_r10.lo \ --- 652,664 ---- am__objects_20 = reshape_i4.lo reshape_i8.lo reshape_i16.lo \ reshape_r4.lo reshape_r8.lo reshape_r10.lo reshape_r16.lo \ reshape_c4.lo reshape_c8.lo reshape_c10.lo reshape_c16.lo ! am__objects_21 = in_pack_i1.lo in_pack_i2.lo in_pack_i4.lo \ ! in_pack_i8.lo in_pack_i16.lo in_pack_r4.lo in_pack_r8.lo \ ! in_pack_r10.lo in_pack_r16.lo in_pack_c4.lo in_pack_c8.lo \ ! in_pack_c10.lo in_pack_c16.lo ! am__objects_22 = in_unpack_i1.lo in_unpack_i2.lo in_unpack_i4.lo \ ! in_unpack_i8.lo in_unpack_i16.lo in_unpack_r4.lo \ ! in_unpack_r8.lo in_unpack_r10.lo in_unpack_r16.lo \ in_unpack_c4.lo in_unpack_c8.lo in_unpack_c10.lo \ in_unpack_c16.lo am__objects_23 = exponent_r4.lo exponent_r8.lo exponent_r10.lo \ *************** am__objects_28 = rrspacing_r4.lo rrspaci *** 615,621 **** rrspacing_r16.lo am__objects_29 = spacing_r4.lo spacing_r8.lo spacing_r10.lo \ spacing_r16.lo ! am__objects_30 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \ $(am__objects_5) $(am__objects_6) $(am__objects_7) \ $(am__objects_8) $(am__objects_9) $(am__objects_10) \ $(am__objects_11) $(am__objects_12) $(am__objects_13) \ --- 681,702 ---- rrspacing_r16.lo am__objects_29 = spacing_r4.lo spacing_r8.lo spacing_r10.lo \ spacing_r16.lo ! am__objects_30 = pack_i1.lo pack_i2.lo pack_i4.lo pack_i8.lo \ ! pack_i16.lo pack_r4.lo pack_r8.lo pack_r10.lo pack_r16.lo \ ! pack_c4.lo pack_c8.lo pack_c10.lo pack_c16.lo ! am__objects_31 = unpack_i1.lo unpack_i2.lo unpack_i4.lo unpack_i8.lo \ ! unpack_i16.lo unpack_r4.lo unpack_r8.lo unpack_r10.lo \ ! unpack_r16.lo unpack_c4.lo unpack_c8.lo unpack_c10.lo \ ! unpack_c16.lo ! am__objects_32 = spread_i1.lo spread_i2.lo spread_i4.lo spread_i8.lo \ ! spread_i16.lo spread_r4.lo spread_r8.lo spread_r10.lo \ ! spread_r16.lo spread_c4.lo spread_c8.lo spread_c10.lo \ ! spread_c16.lo ! am__objects_33 = cshift0_i1.lo cshift0_i2.lo cshift0_i4.lo \ ! cshift0_i8.lo cshift0_i16.lo cshift0_r4.lo cshift0_r8.lo \ ! cshift0_r10.lo cshift0_r16.lo cshift0_c4.lo cshift0_c8.lo \ ! cshift0_c10.lo cshift0_c16.lo ! am__objects_34 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \ $(am__objects_5) $(am__objects_6) $(am__objects_7) \ $(am__objects_8) $(am__objects_9) $(am__objects_10) \ $(am__objects_11) $(am__objects_12) $(am__objects_13) \ *************** am__objects_30 = $(am__objects_2) $(am__ *** 624,648 **** $(am__objects_20) $(am__objects_21) $(am__objects_22) \ $(am__objects_23) $(am__objects_24) $(am__objects_25) \ $(am__objects_26) $(am__objects_27) $(am__objects_28) \ ! $(am__objects_29) ! am__objects_31 = close.lo file_pos.lo format.lo inquire.lo \ intrinsics.lo list_read.lo lock.lo open.lo read.lo \ ! size_from_kind.lo transfer.lo unit.lo unix.lo write.lo ! am__objects_32 = associated.lo abort.lo access.lo args.lo \ c99_functions.lo chdir.lo chmod.lo clock.lo cpu_time.lo \ cshift0.lo ctime.lo date_and_time.lo dtime.lo env.lo \ ! eoshift0.lo eoshift2.lo etime.lo exit.lo fnum.lo gerror.lo \ ! getcwd.lo getlog.lo getXid.lo hostnm.lo ierrno.lo ishftc.lo \ ! iso_c_generated_procs.lo iso_c_binding.lo kill.lo link.lo \ ! malloc.lo mvbits.lo move_alloc.lo pack_generic.lo perror.lo \ ! signal.lo size.lo sleep.lo spread_generic.lo \ ! string_intrinsics.lo system.lo rand.lo random.lo rename.lo \ ! reshape_generic.lo reshape_packed.lo selected_int_kind.lo \ ! selected_real_kind.lo stat.lo symlnk.lo system_clock.lo \ ! time.lo transpose_generic.lo umask.lo unlink.lo \ ! unpack_generic.lo in_pack_generic.lo in_unpack_generic.lo ! am__objects_33 = ! am__objects_34 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \ _abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \ _abs_r10.lo _abs_r16.lo _aimag_c4.lo _aimag_c8.lo \ _aimag_c10.lo _aimag_c16.lo _exp_r4.lo _exp_r8.lo _exp_r10.lo \ --- 705,731 ---- $(am__objects_20) $(am__objects_21) $(am__objects_22) \ $(am__objects_23) $(am__objects_24) $(am__objects_25) \ $(am__objects_26) $(am__objects_27) $(am__objects_28) \ ! $(am__objects_29) $(am__objects_30) $(am__objects_31) \ ! $(am__objects_32) $(am__objects_33) ! am__objects_35 = close.lo file_pos.lo format.lo inquire.lo \ intrinsics.lo list_read.lo lock.lo open.lo read.lo \ ! size_from_kind.lo transfer.lo unit.lo unix.lo write.lo fbuf.lo ! am__objects_36 = associated.lo abort.lo access.lo args.lo \ c99_functions.lo chdir.lo chmod.lo clock.lo cpu_time.lo \ cshift0.lo ctime.lo date_and_time.lo dtime.lo env.lo \ ! eoshift0.lo eoshift2.lo erfc_scaled.lo etime.lo exit.lo \ ! fnum.lo gerror.lo getcwd.lo getlog.lo getXid.lo hostnm.lo \ ! ierrno.lo ishftc.lo iso_c_generated_procs.lo iso_c_binding.lo \ ! kill.lo link.lo malloc.lo mvbits.lo move_alloc.lo \ ! pack_generic.lo perror.lo selected_char_kind.lo signal.lo \ ! size.lo sleep.lo spread_generic.lo string_intrinsics.lo \ ! system.lo rand.lo random.lo rename.lo reshape_generic.lo \ ! reshape_packed.lo selected_int_kind.lo selected_real_kind.lo \ ! stat.lo symlnk.lo system_clock.lo time.lo transpose_generic.lo \ ! umask.lo unlink.lo unpack_generic.lo in_pack_generic.lo \ ! in_unpack_generic.lo ! am__objects_37 = ! am__objects_38 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \ _abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \ _abs_r10.lo _abs_r16.lo _aimag_c4.lo _aimag_c8.lo \ _aimag_c10.lo _aimag_c16.lo _exp_r4.lo _exp_r8.lo _exp_r10.lo \ *************** am__objects_34 = _abs_c4.lo _abs_c8.lo _ *** 666,683 **** _conjg_c4.lo _conjg_c8.lo _conjg_c10.lo _conjg_c16.lo \ _aint_r4.lo _aint_r8.lo _aint_r10.lo _aint_r16.lo _anint_r4.lo \ _anint_r8.lo _anint_r10.lo _anint_r16.lo ! am__objects_35 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \ _sign_r8.lo _sign_r10.lo _sign_r16.lo _dim_i4.lo _dim_i8.lo \ _dim_i16.lo _dim_r4.lo _dim_r8.lo _dim_r10.lo _dim_r16.lo \ _atan2_r4.lo _atan2_r8.lo _atan2_r10.lo _atan2_r16.lo \ _mod_i4.lo _mod_i8.lo _mod_i16.lo _mod_r4.lo _mod_r8.lo \ _mod_r10.lo _mod_r16.lo ! am__objects_36 = misc_specifics.lo ! am__objects_37 = $(am__objects_34) $(am__objects_35) $(am__objects_36) \ dprod_r8.lo f2c_specifics.lo ! am__objects_38 = $(am__objects_1) $(am__objects_30) $(am__objects_31) \ ! $(am__objects_32) $(am__objects_33) $(am__objects_37) ! @onestep_FALSE@am_libgfortran_la_OBJECTS = $(am__objects_38) @onestep_TRUE@am_libgfortran_la_OBJECTS = libgfortran_c.lo libgfortran_la_OBJECTS = $(am_libgfortran_la_OBJECTS) libgfortranbegin_la_LIBADD = --- 749,766 ---- _conjg_c4.lo _conjg_c8.lo _conjg_c10.lo _conjg_c16.lo \ _aint_r4.lo _aint_r8.lo _aint_r10.lo _aint_r16.lo _anint_r4.lo \ _anint_r8.lo _anint_r10.lo _anint_r16.lo ! am__objects_39 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \ _sign_r8.lo _sign_r10.lo _sign_r16.lo _dim_i4.lo _dim_i8.lo \ _dim_i16.lo _dim_r4.lo _dim_r8.lo _dim_r10.lo _dim_r16.lo \ _atan2_r4.lo _atan2_r8.lo _atan2_r10.lo _atan2_r16.lo \ _mod_i4.lo _mod_i8.lo _mod_i16.lo _mod_r4.lo _mod_r8.lo \ _mod_r10.lo _mod_r16.lo ! am__objects_40 = misc_specifics.lo ! am__objects_41 = $(am__objects_38) $(am__objects_39) $(am__objects_40) \ dprod_r8.lo f2c_specifics.lo ! am__objects_42 = $(am__objects_1) $(am__objects_34) $(am__objects_35) \ ! $(am__objects_36) $(am__objects_37) $(am__objects_41) ! @onestep_FALSE@am_libgfortran_la_OBJECTS = $(am__objects_42) @onestep_TRUE@am_libgfortran_la_OBJECTS = libgfortran_c.lo libgfortran_la_OBJECTS = $(am_libgfortran_la_OBJECTS) libgfortranbegin_la_LIBADD = *************** ACLOCAL = @ACLOCAL@ *** 730,736 **** AMDEP_FALSE = @AMDEP_FALSE@ AMDEP_TRUE = @AMDEP_TRUE@ AMTAR = @AMTAR@ ! AM_CFLAGS = @AM_CFLAGS@ AM_FCFLAGS = @AM_FCFLAGS@ AR = @AR@ AS = @AS@ --- 813,821 ---- AMDEP_FALSE = @AMDEP_FALSE@ AMDEP_TRUE = @AMDEP_TRUE@ AMTAR = @AMTAR@ ! ! # Fortran rules for complex multiplication and division ! AM_CFLAGS = @AM_CFLAGS@ -fcx-fortran-rules AM_FCFLAGS = @AM_FCFLAGS@ AR = @AR@ AS = @AS@ *************** CPPFLAGS = @CPPFLAGS@ *** 746,751 **** --- 831,837 ---- CYGPATH_W = @CYGPATH_W@ DEFS = @DEFS@ DEPDIR = @DEPDIR@ + DSYMUTIL = @DSYMUTIL@ DUMPBIN = @DUMPBIN@ ECHO_C = @ECHO_C@ ECHO_N = @ECHO_N@ *************** LIBGFOR_USE_SYMVER_TRUE = @LIBGFOR_USE_S *** 768,773 **** --- 854,860 ---- LIBOBJS = @LIBOBJS@ LIBS = @LIBS@ LIBTOOL = @LIBTOOL@ + LIPO = @LIPO@ LN_S = @LN_S@ LTLIBOBJS = @LTLIBOBJS@ MAINT = @MAINT@ *************** MAINTAINER_MODE_FALSE = @MAINTAINER_MODE *** 775,781 **** --- 862,872 ---- MAINTAINER_MODE_TRUE = @MAINTAINER_MODE_TRUE@ MAKEINFO = @MAKEINFO@ NM = @NM@ + NMEDIT = @NMEDIT@ + OBJDUMP = @OBJDUMP@ OBJEXT = @OBJEXT@ + OTOOL = @OTOOL@ + OTOOL64 = @OTOOL64@ PACKAGE = @PACKAGE@ PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ PACKAGE_NAME = @PACKAGE_NAME@ *************** VERSION = @VERSION@ *** 792,799 **** --- 883,896 ---- ac_ct_AR = @ac_ct_AR@ ac_ct_AS = @ac_ct_AS@ ac_ct_CC = @ac_ct_CC@ + ac_ct_DSYMUTIL = @ac_ct_DSYMUTIL@ ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ ac_ct_FC = @ac_ct_FC@ + ac_ct_LIPO = @ac_ct_LIPO@ + ac_ct_NMEDIT = @ac_ct_NMEDIT@ + ac_ct_OBJDUMP = @ac_ct_OBJDUMP@ + ac_ct_OTOOL = @ac_ct_OTOOL@ + ac_ct_OTOOL64 = @ac_ct_OTOOL64@ ac_ct_RANLIB = @ac_ct_RANLIB@ ac_ct_STRIP = @ac_ct_STRIP@ am__fastdepCC_FALSE = @am__fastdepCC_FALSE@ *************** ACLOCAL_AMFLAGS = -I .. -I ../config *** 853,861 **** gcc_version := $(shell cat $(top_srcdir)/../gcc/BASE-VER) @LIBGFOR_USE_SYMVER_FALSE@version_arg = @LIBGFOR_USE_SYMVER_TRUE@version_arg = -Wl,--version-script=$(srcdir)/gfortran.map toolexeclib_LTLIBRARIES = libgfortran.la libgfortran_la_LINK = $(LINK) ! libgfortran_la_LDFLAGS = -version-info `grep -v '^\#' $(srcdir)/libtool-version` -lm $(extra_ldflags_libgfortran) $(version_arg) myexeclib_LTLIBRARIES = libgfortranbegin.la myexeclibdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR) libgfortranbegin_la_SOURCES = fmain.c --- 950,959 ---- gcc_version := $(shell cat $(top_srcdir)/../gcc/BASE-VER) @LIBGFOR_USE_SYMVER_FALSE@version_arg = @LIBGFOR_USE_SYMVER_TRUE@version_arg = -Wl,--version-script=$(srcdir)/gfortran.map + LTLDFLAGS = $(shell $(SHELL) $(top_srcdir)/../libtool-ldflags $(LDFLAGS)) toolexeclib_LTLIBRARIES = libgfortran.la libgfortran_la_LINK = $(LINK) ! libgfortran_la_LDFLAGS = -version-info `grep -v '^\#' $(srcdir)/libtool-version` $(LTLDFLAGS) -lm $(extra_ldflags_libgfortran) $(version_arg) myexeclib_LTLIBRARIES = libgfortranbegin.la myexeclibdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR) libgfortranbegin_la_SOURCES = fmain.c *************** io/size_from_kind.c \ *** 878,884 **** io/transfer.c \ io/unit.c \ io/unix.c \ ! io/write.c gfor_io_headers = \ io/io.h --- 976,983 ---- io/transfer.c \ io/unit.c \ io/unix.c \ ! io/write.c \ ! io/fbuf.c gfor_io_headers = \ io/io.h *************** intrinsics/dtime.c \ *** 900,905 **** --- 999,1005 ---- intrinsics/env.c \ intrinsics/eoshift0.c \ intrinsics/eoshift2.c \ + intrinsics/erfc_scaled.c \ intrinsics/etime.c \ intrinsics/exit.c \ intrinsics/fnum.c \ *************** intrinsics/mvbits.c \ *** 919,924 **** --- 1019,1025 ---- intrinsics/move_alloc.c \ intrinsics/pack_generic.c \ intrinsics/perror.c \ + intrinsics/selected_char_kind.c \ intrinsics/signal.c \ intrinsics/size.c \ intrinsics/sleep.c \ *************** runtime/in_unpack_generic.c *** 946,951 **** --- 1047,1053 ---- gfor_src = \ runtime/backtrace.c \ runtime/compile_options.c \ + runtime/convert_char.c \ runtime/environ.c \ runtime/error.c \ runtime/fpu.c \ *************** $(srcdir)/generated/eoshift3_4.c \ *** 1206,1229 **** --- 1308,1358 ---- $(srcdir)/generated/eoshift3_8.c \ $(srcdir)/generated/eoshift3_16.c + i_cshift0_c = \ + $(srcdir)/generated/cshift0_i1.c \ + $(srcdir)/generated/cshift0_i2.c \ + $(srcdir)/generated/cshift0_i4.c \ + $(srcdir)/generated/cshift0_i8.c \ + $(srcdir)/generated/cshift0_i16.c \ + $(srcdir)/generated/cshift0_r4.c \ + $(srcdir)/generated/cshift0_r8.c \ + $(srcdir)/generated/cshift0_r10.c \ + $(srcdir)/generated/cshift0_r16.c \ + $(srcdir)/generated/cshift0_c4.c \ + $(srcdir)/generated/cshift0_c8.c \ + $(srcdir)/generated/cshift0_c10.c \ + $(srcdir)/generated/cshift0_c16.c + i_cshift1_c = \ $(srcdir)/generated/cshift1_4.c \ $(srcdir)/generated/cshift1_8.c \ $(srcdir)/generated/cshift1_16.c in_pack_c = \ + $(srcdir)/generated/in_pack_i1.c \ + $(srcdir)/generated/in_pack_i2.c \ $(srcdir)/generated/in_pack_i4.c \ $(srcdir)/generated/in_pack_i8.c \ $(srcdir)/generated/in_pack_i16.c \ + $(srcdir)/generated/in_pack_r4.c \ + $(srcdir)/generated/in_pack_r8.c \ + $(srcdir)/generated/in_pack_r10.c \ + $(srcdir)/generated/in_pack_r16.c \ $(srcdir)/generated/in_pack_c4.c \ $(srcdir)/generated/in_pack_c8.c \ $(srcdir)/generated/in_pack_c10.c \ $(srcdir)/generated/in_pack_c16.c in_unpack_c = \ + $(srcdir)/generated/in_unpack_i1.c \ + $(srcdir)/generated/in_unpack_i2.c \ $(srcdir)/generated/in_unpack_i4.c \ $(srcdir)/generated/in_unpack_i8.c \ $(srcdir)/generated/in_unpack_i16.c \ + $(srcdir)/generated/in_unpack_r4.c \ + $(srcdir)/generated/in_unpack_r8.c \ + $(srcdir)/generated/in_unpack_r10.c \ + $(srcdir)/generated/in_unpack_r16.c \ $(srcdir)/generated/in_unpack_c4.c \ $(srcdir)/generated/in_unpack_c8.c \ $(srcdir)/generated/in_unpack_c10.c \ *************** $(srcdir)/generated/pow_c8_i16.c \ *** 1296,1301 **** --- 1425,1475 ---- $(srcdir)/generated/pow_c10_i16.c \ $(srcdir)/generated/pow_c16_i16.c + i_pack_c = \ + $(srcdir)/generated/pack_i1.c \ + $(srcdir)/generated/pack_i2.c \ + $(srcdir)/generated/pack_i4.c \ + $(srcdir)/generated/pack_i8.c \ + $(srcdir)/generated/pack_i16.c \ + $(srcdir)/generated/pack_r4.c \ + $(srcdir)/generated/pack_r8.c \ + $(srcdir)/generated/pack_r10.c \ + $(srcdir)/generated/pack_r16.c \ + $(srcdir)/generated/pack_c4.c \ + $(srcdir)/generated/pack_c8.c \ + $(srcdir)/generated/pack_c10.c \ + $(srcdir)/generated/pack_c16.c + + i_unpack_c = \ + $(srcdir)/generated/unpack_i1.c \ + $(srcdir)/generated/unpack_i2.c \ + $(srcdir)/generated/unpack_i4.c \ + $(srcdir)/generated/unpack_i8.c \ + $(srcdir)/generated/unpack_i16.c \ + $(srcdir)/generated/unpack_r4.c \ + $(srcdir)/generated/unpack_r8.c \ + $(srcdir)/generated/unpack_r10.c \ + $(srcdir)/generated/unpack_r16.c \ + $(srcdir)/generated/unpack_c4.c \ + $(srcdir)/generated/unpack_c8.c \ + $(srcdir)/generated/unpack_c10.c \ + $(srcdir)/generated/unpack_c16.c + + i_spread_c = \ + $(srcdir)/generated/spread_i1.c \ + $(srcdir)/generated/spread_i2.c \ + $(srcdir)/generated/spread_i4.c \ + $(srcdir)/generated/spread_i8.c \ + $(srcdir)/generated/spread_i16.c \ + $(srcdir)/generated/spread_r4.c \ + $(srcdir)/generated/spread_r8.c \ + $(srcdir)/generated/spread_r10.c \ + $(srcdir)/generated/spread_r16.c \ + $(srcdir)/generated/spread_c4.c \ + $(srcdir)/generated/spread_c8.c \ + $(srcdir)/generated/spread_c10.c \ + $(srcdir)/generated/spread_c16.c + m4_files = m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \ m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \ m4/minloc0.m4 m4/minloc1.m4 m4/minval.m4 m4/product.m4 m4/sum.m4 \ *************** m4_files = m4/iparm.m4 m4/ifunction.m4 m *** 1304,1310 **** m4/specific.m4 m4/specific2.m4 m4/head.m4 m4/shape.m4 m4/reshape.m4 \ m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \ m4/fraction.m4 m4/nearest.m4 m4/set_exponent.m4 m4/pow.m4 \ ! m4/misc_specifics.m4 m4/rrspacing.m4 m4/spacing.m4 gfor_built_src = $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \ $(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \ --- 1478,1485 ---- m4/specific.m4 m4/specific2.m4 m4/head.m4 m4/shape.m4 m4/reshape.m4 \ m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \ m4/fraction.m4 m4/nearest.m4 m4/set_exponent.m4 m4/pow.m4 \ ! m4/misc_specifics.m4 m4/rrspacing.m4 m4/spacing.m4 m4/pack.m4 \ ! m4/unpack.m4 m4/spread.m4 gfor_built_src = $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \ $(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \ *************** gfor_built_src = $(i_all_c) $(i_any_c) $ *** 1312,1320 **** $(i_matmul_c) $(i_matmull_c) $(i_transpose_c) $(i_shape_c) $(i_eoshift1_c) \ $(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \ $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \ ! $(i_pow_c) $(i_rrspacing_c) $(i_spacing_c) \ ! selected_int_kind.inc selected_real_kind.inc kinds.h \ ! kinds.inc c99_protos.inc fpu-target.h # Machine generated specifics --- 1487,1495 ---- $(i_matmul_c) $(i_matmull_c) $(i_transpose_c) $(i_shape_c) $(i_eoshift1_c) \ $(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \ $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \ ! $(i_pow_c) $(i_rrspacing_c) $(i_spacing_c) $(i_pack_c) $(i_unpack_c) \ ! $(i_spread_c) selected_int_kind.inc selected_real_kind.inc kinds.h \ ! $(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h # Machine generated specifics *************** distclean-compile: *** 1632,1637 **** --- 1807,1813 ---- @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/clock.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/close.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/compile_options.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/convert_char.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_16_l.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_1_l.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_2_l.Plo@am__quote@ *************** distclean-compile: *** 1639,1644 **** --- 1815,1833 ---- @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_8_l.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cpu_time.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_c10.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_c16.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_c4.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_c8.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_i1.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_i16.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_i2.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_i4.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_i8.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_r10.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_r16.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_r4.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_r8.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift1_16.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift1_4.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift1_8.Plo@am__quote@ *************** distclean-compile: *** 1655,1660 **** --- 1844,1850 ---- @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift3_16.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift3_4.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift3_8.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/erfc_scaled.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/error.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/etime.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exit.Plo@am__quote@ *************** distclean-compile: *** 1662,1667 **** --- 1852,1858 ---- @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r16.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r4.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r8.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fbuf.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/file_pos.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fmain.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fnum.Plo@am__quote@ *************** distclean-compile: *** 1682,1698 **** --- 1873,1901 ---- @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_c4.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_c8.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_generic.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_i1.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_i16.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_i2.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_i4.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_i8.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_r10.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_r16.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_r4.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_r8.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_c10.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_c16.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_c4.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_c8.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_generic.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_i1.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_i16.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_i2.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_i4.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_i8.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_r10.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_r16.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_r4.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_r8.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/inquire.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/intrinsics.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ishftc.Plo@am__quote@ *************** distclean-compile: *** 1855,1861 **** --- 2058,2077 ---- @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/nearest_r4.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/nearest_r8.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/open.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_c10.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_c16.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_c4.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_c8.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_generic.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_i1.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_i16.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_i2.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_i4.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_i8.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_r10.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_r16.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_r4.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_r8.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pause.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/perror.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_c10_i16.Plo@am__quote@ *************** distclean-compile: *** 1922,1927 **** --- 2138,2144 ---- @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/rrspacing_r4.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/rrspacing_r8.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/select.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/selected_char_kind.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/set_exponent_r10.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/set_exponent_r16.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/set_exponent_r4.Plo@am__quote@ *************** distclean-compile: *** 1937,1943 **** --- 2154,2173 ---- @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spacing_r16.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spacing_r4.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spacing_r8.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_c10.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_c16.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_c4.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_c8.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_generic.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_i1.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_i16.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_i2.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_i4.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_i8.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_r10.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_r16.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_r4.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_r8.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stat.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stop.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/string.Plo@am__quote@ *************** distclean-compile: *** 1976,1982 **** --- 2206,2225 ---- @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unit.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unix.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unlink.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_c10.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_c16.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_c4.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_c8.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_generic.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_i1.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_i16.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_i2.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_i4.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_i8.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_r10.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_r16.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_r4.Plo@am__quote@ + @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_r8.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/write.Plo@am__quote@ .F90.o: *************** compile_options.lo: runtime/compile_opti *** 2437,2442 **** --- 2680,2692 ---- @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o compile_options.lo `test -f 'runtime/compile_options.c' || echo '$(srcdir)/'`runtime/compile_options.c + convert_char.lo: runtime/convert_char.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT convert_char.lo -MD -MP -MF "$(DEPDIR)/convert_char.Tpo" -c -o convert_char.lo `test -f 'runtime/convert_char.c' || echo '$(srcdir)/'`runtime/convert_char.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/convert_char.Tpo" "$(DEPDIR)/convert_char.Plo"; else rm -f "$(DEPDIR)/convert_char.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/convert_char.c' object='convert_char.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o convert_char.lo `test -f 'runtime/convert_char.c' || echo '$(srcdir)/'`runtime/convert_char.c + environ.lo: runtime/environ.c @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT environ.lo -MD -MP -MF "$(DEPDIR)/environ.Tpo" -c -o environ.lo `test -f 'runtime/environ.c' || echo '$(srcdir)/'`runtime/environ.c; \ @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/environ.Tpo" "$(DEPDIR)/environ.Plo"; else rm -f "$(DEPDIR)/environ.Tpo"; exit 1; fi *************** reshape_c16.lo: $(srcdir)/generated/resh *** 4019,4024 **** --- 4269,4288 ---- @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c16.lo `test -f '$(srcdir)/generated/reshape_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_c16.c + in_pack_i1.lo: $(srcdir)/generated/in_pack_i1.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_i1.lo -MD -MP -MF "$(DEPDIR)/in_pack_i1.Tpo" -c -o in_pack_i1.lo `test -f '$(srcdir)/generated/in_pack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i1.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_pack_i1.Tpo" "$(DEPDIR)/in_pack_i1.Plo"; else rm -f "$(DEPDIR)/in_pack_i1.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_i1.c' object='in_pack_i1.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i1.lo `test -f '$(srcdir)/generated/in_pack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i1.c + + in_pack_i2.lo: $(srcdir)/generated/in_pack_i2.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_i2.lo -MD -MP -MF "$(DEPDIR)/in_pack_i2.Tpo" -c -o in_pack_i2.lo `test -f '$(srcdir)/generated/in_pack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i2.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_pack_i2.Tpo" "$(DEPDIR)/in_pack_i2.Plo"; else rm -f "$(DEPDIR)/in_pack_i2.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_i2.c' object='in_pack_i2.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i2.lo `test -f '$(srcdir)/generated/in_pack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i2.c + in_pack_i4.lo: $(srcdir)/generated/in_pack_i4.c @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_i4.lo -MD -MP -MF "$(DEPDIR)/in_pack_i4.Tpo" -c -o in_pack_i4.lo `test -f '$(srcdir)/generated/in_pack_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i4.c; \ @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_pack_i4.Tpo" "$(DEPDIR)/in_pack_i4.Plo"; else rm -f "$(DEPDIR)/in_pack_i4.Tpo"; exit 1; fi *************** in_pack_i16.lo: $(srcdir)/generated/in_p *** 4040,4045 **** --- 4304,4337 ---- @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i16.lo `test -f '$(srcdir)/generated/in_pack_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i16.c + in_pack_r4.lo: $(srcdir)/generated/in_pack_r4.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_r4.lo -MD -MP -MF "$(DEPDIR)/in_pack_r4.Tpo" -c -o in_pack_r4.lo `test -f '$(srcdir)/generated/in_pack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r4.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_pack_r4.Tpo" "$(DEPDIR)/in_pack_r4.Plo"; else rm -f "$(DEPDIR)/in_pack_r4.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_r4.c' object='in_pack_r4.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_r4.lo `test -f '$(srcdir)/generated/in_pack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r4.c + + in_pack_r8.lo: $(srcdir)/generated/in_pack_r8.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_r8.lo -MD -MP -MF "$(DEPDIR)/in_pack_r8.Tpo" -c -o in_pack_r8.lo `test -f '$(srcdir)/generated/in_pack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r8.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_pack_r8.Tpo" "$(DEPDIR)/in_pack_r8.Plo"; else rm -f "$(DEPDIR)/in_pack_r8.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_r8.c' object='in_pack_r8.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_r8.lo `test -f '$(srcdir)/generated/in_pack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r8.c + + in_pack_r10.lo: $(srcdir)/generated/in_pack_r10.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_r10.lo -MD -MP -MF "$(DEPDIR)/in_pack_r10.Tpo" -c -o in_pack_r10.lo `test -f '$(srcdir)/generated/in_pack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r10.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_pack_r10.Tpo" "$(DEPDIR)/in_pack_r10.Plo"; else rm -f "$(DEPDIR)/in_pack_r10.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_r10.c' object='in_pack_r10.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_r10.lo `test -f '$(srcdir)/generated/in_pack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r10.c + + in_pack_r16.lo: $(srcdir)/generated/in_pack_r16.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_r16.lo -MD -MP -MF "$(DEPDIR)/in_pack_r16.Tpo" -c -o in_pack_r16.lo `test -f '$(srcdir)/generated/in_pack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r16.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_pack_r16.Tpo" "$(DEPDIR)/in_pack_r16.Plo"; else rm -f "$(DEPDIR)/in_pack_r16.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_r16.c' object='in_pack_r16.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_r16.lo `test -f '$(srcdir)/generated/in_pack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r16.c + in_pack_c4.lo: $(srcdir)/generated/in_pack_c4.c @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_c4.lo -MD -MP -MF "$(DEPDIR)/in_pack_c4.Tpo" -c -o in_pack_c4.lo `test -f '$(srcdir)/generated/in_pack_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_c4.c; \ @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_pack_c4.Tpo" "$(DEPDIR)/in_pack_c4.Plo"; else rm -f "$(DEPDIR)/in_pack_c4.Tpo"; exit 1; fi *************** in_pack_c16.lo: $(srcdir)/generated/in_p *** 4068,4073 **** --- 4360,4379 ---- @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c16.lo `test -f '$(srcdir)/generated/in_pack_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_c16.c + in_unpack_i1.lo: $(srcdir)/generated/in_unpack_i1.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_i1.lo -MD -MP -MF "$(DEPDIR)/in_unpack_i1.Tpo" -c -o in_unpack_i1.lo `test -f '$(srcdir)/generated/in_unpack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i1.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_unpack_i1.Tpo" "$(DEPDIR)/in_unpack_i1.Plo"; else rm -f "$(DEPDIR)/in_unpack_i1.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_i1.c' object='in_unpack_i1.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i1.lo `test -f '$(srcdir)/generated/in_unpack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i1.c + + in_unpack_i2.lo: $(srcdir)/generated/in_unpack_i2.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_i2.lo -MD -MP -MF "$(DEPDIR)/in_unpack_i2.Tpo" -c -o in_unpack_i2.lo `test -f '$(srcdir)/generated/in_unpack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i2.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_unpack_i2.Tpo" "$(DEPDIR)/in_unpack_i2.Plo"; else rm -f "$(DEPDIR)/in_unpack_i2.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_i2.c' object='in_unpack_i2.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i2.lo `test -f '$(srcdir)/generated/in_unpack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i2.c + in_unpack_i4.lo: $(srcdir)/generated/in_unpack_i4.c @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_i4.lo -MD -MP -MF "$(DEPDIR)/in_unpack_i4.Tpo" -c -o in_unpack_i4.lo `test -f '$(srcdir)/generated/in_unpack_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i4.c; \ @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_unpack_i4.Tpo" "$(DEPDIR)/in_unpack_i4.Plo"; else rm -f "$(DEPDIR)/in_unpack_i4.Tpo"; exit 1; fi *************** in_unpack_i16.lo: $(srcdir)/generated/in *** 4089,4094 **** --- 4395,4428 ---- @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i16.lo `test -f '$(srcdir)/generated/in_unpack_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i16.c + in_unpack_r4.lo: $(srcdir)/generated/in_unpack_r4.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_r4.lo -MD -MP -MF "$(DEPDIR)/in_unpack_r4.Tpo" -c -o in_unpack_r4.lo `test -f '$(srcdir)/generated/in_unpack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r4.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_unpack_r4.Tpo" "$(DEPDIR)/in_unpack_r4.Plo"; else rm -f "$(DEPDIR)/in_unpack_r4.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_r4.c' object='in_unpack_r4.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_r4.lo `test -f '$(srcdir)/generated/in_unpack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r4.c + + in_unpack_r8.lo: $(srcdir)/generated/in_unpack_r8.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_r8.lo -MD -MP -MF "$(DEPDIR)/in_unpack_r8.Tpo" -c -o in_unpack_r8.lo `test -f '$(srcdir)/generated/in_unpack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r8.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_unpack_r8.Tpo" "$(DEPDIR)/in_unpack_r8.Plo"; else rm -f "$(DEPDIR)/in_unpack_r8.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_r8.c' object='in_unpack_r8.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_r8.lo `test -f '$(srcdir)/generated/in_unpack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r8.c + + in_unpack_r10.lo: $(srcdir)/generated/in_unpack_r10.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_r10.lo -MD -MP -MF "$(DEPDIR)/in_unpack_r10.Tpo" -c -o in_unpack_r10.lo `test -f '$(srcdir)/generated/in_unpack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r10.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_unpack_r10.Tpo" "$(DEPDIR)/in_unpack_r10.Plo"; else rm -f "$(DEPDIR)/in_unpack_r10.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_r10.c' object='in_unpack_r10.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_r10.lo `test -f '$(srcdir)/generated/in_unpack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r10.c + + in_unpack_r16.lo: $(srcdir)/generated/in_unpack_r16.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_r16.lo -MD -MP -MF "$(DEPDIR)/in_unpack_r16.Tpo" -c -o in_unpack_r16.lo `test -f '$(srcdir)/generated/in_unpack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r16.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_unpack_r16.Tpo" "$(DEPDIR)/in_unpack_r16.Plo"; else rm -f "$(DEPDIR)/in_unpack_r16.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_r16.c' object='in_unpack_r16.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_r16.lo `test -f '$(srcdir)/generated/in_unpack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r16.c + in_unpack_c4.lo: $(srcdir)/generated/in_unpack_c4.c @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_c4.lo -MD -MP -MF "$(DEPDIR)/in_unpack_c4.Tpo" -c -o in_unpack_c4.lo `test -f '$(srcdir)/generated/in_unpack_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_c4.c; \ @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_unpack_c4.Tpo" "$(DEPDIR)/in_unpack_c4.Plo"; else rm -f "$(DEPDIR)/in_unpack_c4.Tpo"; exit 1; fi *************** spacing_r16.lo: $(srcdir)/generated/spac *** 4488,4493 **** --- 4822,5191 ---- @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spacing_r16.lo `test -f '$(srcdir)/generated/spacing_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/spacing_r16.c + pack_i1.lo: $(srcdir)/generated/pack_i1.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_i1.lo -MD -MP -MF "$(DEPDIR)/pack_i1.Tpo" -c -o pack_i1.lo `test -f '$(srcdir)/generated/pack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i1.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/pack_i1.Tpo" "$(DEPDIR)/pack_i1.Plo"; else rm -f "$(DEPDIR)/pack_i1.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_i1.c' object='pack_i1.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_i1.lo `test -f '$(srcdir)/generated/pack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i1.c + + pack_i2.lo: $(srcdir)/generated/pack_i2.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_i2.lo -MD -MP -MF "$(DEPDIR)/pack_i2.Tpo" -c -o pack_i2.lo `test -f '$(srcdir)/generated/pack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i2.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/pack_i2.Tpo" "$(DEPDIR)/pack_i2.Plo"; else rm -f "$(DEPDIR)/pack_i2.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_i2.c' object='pack_i2.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_i2.lo `test -f '$(srcdir)/generated/pack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i2.c + + pack_i4.lo: $(srcdir)/generated/pack_i4.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_i4.lo -MD -MP -MF "$(DEPDIR)/pack_i4.Tpo" -c -o pack_i4.lo `test -f '$(srcdir)/generated/pack_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i4.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/pack_i4.Tpo" "$(DEPDIR)/pack_i4.Plo"; else rm -f "$(DEPDIR)/pack_i4.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_i4.c' object='pack_i4.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_i4.lo `test -f '$(srcdir)/generated/pack_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i4.c + + pack_i8.lo: $(srcdir)/generated/pack_i8.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_i8.lo -MD -MP -MF "$(DEPDIR)/pack_i8.Tpo" -c -o pack_i8.lo `test -f '$(srcdir)/generated/pack_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i8.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/pack_i8.Tpo" "$(DEPDIR)/pack_i8.Plo"; else rm -f "$(DEPDIR)/pack_i8.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_i8.c' object='pack_i8.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_i8.lo `test -f '$(srcdir)/generated/pack_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i8.c + + pack_i16.lo: $(srcdir)/generated/pack_i16.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_i16.lo -MD -MP -MF "$(DEPDIR)/pack_i16.Tpo" -c -o pack_i16.lo `test -f '$(srcdir)/generated/pack_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i16.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/pack_i16.Tpo" "$(DEPDIR)/pack_i16.Plo"; else rm -f "$(DEPDIR)/pack_i16.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_i16.c' object='pack_i16.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_i16.lo `test -f '$(srcdir)/generated/pack_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i16.c + + pack_r4.lo: $(srcdir)/generated/pack_r4.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_r4.lo -MD -MP -MF "$(DEPDIR)/pack_r4.Tpo" -c -o pack_r4.lo `test -f '$(srcdir)/generated/pack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_r4.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/pack_r4.Tpo" "$(DEPDIR)/pack_r4.Plo"; else rm -f "$(DEPDIR)/pack_r4.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_r4.c' object='pack_r4.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_r4.lo `test -f '$(srcdir)/generated/pack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_r4.c + + pack_r8.lo: $(srcdir)/generated/pack_r8.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_r8.lo -MD -MP -MF "$(DEPDIR)/pack_r8.Tpo" -c -o pack_r8.lo `test -f '$(srcdir)/generated/pack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_r8.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/pack_r8.Tpo" "$(DEPDIR)/pack_r8.Plo"; else rm -f "$(DEPDIR)/pack_r8.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_r8.c' object='pack_r8.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_r8.lo `test -f '$(srcdir)/generated/pack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_r8.c + + pack_r10.lo: $(srcdir)/generated/pack_r10.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_r10.lo -MD -MP -MF "$(DEPDIR)/pack_r10.Tpo" -c -o pack_r10.lo `test -f '$(srcdir)/generated/pack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_r10.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/pack_r10.Tpo" "$(DEPDIR)/pack_r10.Plo"; else rm -f "$(DEPDIR)/pack_r10.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_r10.c' object='pack_r10.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_r10.lo `test -f '$(srcdir)/generated/pack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_r10.c + + pack_r16.lo: $(srcdir)/generated/pack_r16.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_r16.lo -MD -MP -MF "$(DEPDIR)/pack_r16.Tpo" -c -o pack_r16.lo `test -f '$(srcdir)/generated/pack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_r16.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/pack_r16.Tpo" "$(DEPDIR)/pack_r16.Plo"; else rm -f "$(DEPDIR)/pack_r16.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_r16.c' object='pack_r16.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_r16.lo `test -f '$(srcdir)/generated/pack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_r16.c + + pack_c4.lo: $(srcdir)/generated/pack_c4.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_c4.lo -MD -MP -MF "$(DEPDIR)/pack_c4.Tpo" -c -o pack_c4.lo `test -f '$(srcdir)/generated/pack_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_c4.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/pack_c4.Tpo" "$(DEPDIR)/pack_c4.Plo"; else rm -f "$(DEPDIR)/pack_c4.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_c4.c' object='pack_c4.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_c4.lo `test -f '$(srcdir)/generated/pack_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_c4.c + + pack_c8.lo: $(srcdir)/generated/pack_c8.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_c8.lo -MD -MP -MF "$(DEPDIR)/pack_c8.Tpo" -c -o pack_c8.lo `test -f '$(srcdir)/generated/pack_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_c8.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/pack_c8.Tpo" "$(DEPDIR)/pack_c8.Plo"; else rm -f "$(DEPDIR)/pack_c8.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_c8.c' object='pack_c8.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_c8.lo `test -f '$(srcdir)/generated/pack_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_c8.c + + pack_c10.lo: $(srcdir)/generated/pack_c10.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_c10.lo -MD -MP -MF "$(DEPDIR)/pack_c10.Tpo" -c -o pack_c10.lo `test -f '$(srcdir)/generated/pack_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_c10.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/pack_c10.Tpo" "$(DEPDIR)/pack_c10.Plo"; else rm -f "$(DEPDIR)/pack_c10.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_c10.c' object='pack_c10.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_c10.lo `test -f '$(srcdir)/generated/pack_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_c10.c + + pack_c16.lo: $(srcdir)/generated/pack_c16.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_c16.lo -MD -MP -MF "$(DEPDIR)/pack_c16.Tpo" -c -o pack_c16.lo `test -f '$(srcdir)/generated/pack_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_c16.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/pack_c16.Tpo" "$(DEPDIR)/pack_c16.Plo"; else rm -f "$(DEPDIR)/pack_c16.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_c16.c' object='pack_c16.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_c16.lo `test -f '$(srcdir)/generated/pack_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_c16.c + + unpack_i1.lo: $(srcdir)/generated/unpack_i1.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_i1.lo -MD -MP -MF "$(DEPDIR)/unpack_i1.Tpo" -c -o unpack_i1.lo `test -f '$(srcdir)/generated/unpack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i1.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/unpack_i1.Tpo" "$(DEPDIR)/unpack_i1.Plo"; else rm -f "$(DEPDIR)/unpack_i1.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_i1.c' object='unpack_i1.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_i1.lo `test -f '$(srcdir)/generated/unpack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i1.c + + unpack_i2.lo: $(srcdir)/generated/unpack_i2.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_i2.lo -MD -MP -MF "$(DEPDIR)/unpack_i2.Tpo" -c -o unpack_i2.lo `test -f '$(srcdir)/generated/unpack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i2.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/unpack_i2.Tpo" "$(DEPDIR)/unpack_i2.Plo"; else rm -f "$(DEPDIR)/unpack_i2.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_i2.c' object='unpack_i2.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_i2.lo `test -f '$(srcdir)/generated/unpack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i2.c + + unpack_i4.lo: $(srcdir)/generated/unpack_i4.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_i4.lo -MD -MP -MF "$(DEPDIR)/unpack_i4.Tpo" -c -o unpack_i4.lo `test -f '$(srcdir)/generated/unpack_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i4.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/unpack_i4.Tpo" "$(DEPDIR)/unpack_i4.Plo"; else rm -f "$(DEPDIR)/unpack_i4.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_i4.c' object='unpack_i4.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_i4.lo `test -f '$(srcdir)/generated/unpack_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i4.c + + unpack_i8.lo: $(srcdir)/generated/unpack_i8.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_i8.lo -MD -MP -MF "$(DEPDIR)/unpack_i8.Tpo" -c -o unpack_i8.lo `test -f '$(srcdir)/generated/unpack_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i8.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/unpack_i8.Tpo" "$(DEPDIR)/unpack_i8.Plo"; else rm -f "$(DEPDIR)/unpack_i8.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_i8.c' object='unpack_i8.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_i8.lo `test -f '$(srcdir)/generated/unpack_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i8.c + + unpack_i16.lo: $(srcdir)/generated/unpack_i16.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_i16.lo -MD -MP -MF "$(DEPDIR)/unpack_i16.Tpo" -c -o unpack_i16.lo `test -f '$(srcdir)/generated/unpack_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i16.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/unpack_i16.Tpo" "$(DEPDIR)/unpack_i16.Plo"; else rm -f "$(DEPDIR)/unpack_i16.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_i16.c' object='unpack_i16.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_i16.lo `test -f '$(srcdir)/generated/unpack_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i16.c + + unpack_r4.lo: $(srcdir)/generated/unpack_r4.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_r4.lo -MD -MP -MF "$(DEPDIR)/unpack_r4.Tpo" -c -o unpack_r4.lo `test -f '$(srcdir)/generated/unpack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_r4.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/unpack_r4.Tpo" "$(DEPDIR)/unpack_r4.Plo"; else rm -f "$(DEPDIR)/unpack_r4.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_r4.c' object='unpack_r4.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_r4.lo `test -f '$(srcdir)/generated/unpack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_r4.c + + unpack_r8.lo: $(srcdir)/generated/unpack_r8.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_r8.lo -MD -MP -MF "$(DEPDIR)/unpack_r8.Tpo" -c -o unpack_r8.lo `test -f '$(srcdir)/generated/unpack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_r8.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/unpack_r8.Tpo" "$(DEPDIR)/unpack_r8.Plo"; else rm -f "$(DEPDIR)/unpack_r8.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_r8.c' object='unpack_r8.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_r8.lo `test -f '$(srcdir)/generated/unpack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_r8.c + + unpack_r10.lo: $(srcdir)/generated/unpack_r10.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_r10.lo -MD -MP -MF "$(DEPDIR)/unpack_r10.Tpo" -c -o unpack_r10.lo `test -f '$(srcdir)/generated/unpack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_r10.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/unpack_r10.Tpo" "$(DEPDIR)/unpack_r10.Plo"; else rm -f "$(DEPDIR)/unpack_r10.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_r10.c' object='unpack_r10.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_r10.lo `test -f '$(srcdir)/generated/unpack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_r10.c + + unpack_r16.lo: $(srcdir)/generated/unpack_r16.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_r16.lo -MD -MP -MF "$(DEPDIR)/unpack_r16.Tpo" -c -o unpack_r16.lo `test -f '$(srcdir)/generated/unpack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_r16.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/unpack_r16.Tpo" "$(DEPDIR)/unpack_r16.Plo"; else rm -f "$(DEPDIR)/unpack_r16.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_r16.c' object='unpack_r16.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_r16.lo `test -f '$(srcdir)/generated/unpack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_r16.c + + unpack_c4.lo: $(srcdir)/generated/unpack_c4.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_c4.lo -MD -MP -MF "$(DEPDIR)/unpack_c4.Tpo" -c -o unpack_c4.lo `test -f '$(srcdir)/generated/unpack_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_c4.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/unpack_c4.Tpo" "$(DEPDIR)/unpack_c4.Plo"; else rm -f "$(DEPDIR)/unpack_c4.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_c4.c' object='unpack_c4.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_c4.lo `test -f '$(srcdir)/generated/unpack_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_c4.c + + unpack_c8.lo: $(srcdir)/generated/unpack_c8.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_c8.lo -MD -MP -MF "$(DEPDIR)/unpack_c8.Tpo" -c -o unpack_c8.lo `test -f '$(srcdir)/generated/unpack_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_c8.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/unpack_c8.Tpo" "$(DEPDIR)/unpack_c8.Plo"; else rm -f "$(DEPDIR)/unpack_c8.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_c8.c' object='unpack_c8.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_c8.lo `test -f '$(srcdir)/generated/unpack_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_c8.c + + unpack_c10.lo: $(srcdir)/generated/unpack_c10.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_c10.lo -MD -MP -MF "$(DEPDIR)/unpack_c10.Tpo" -c -o unpack_c10.lo `test -f '$(srcdir)/generated/unpack_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_c10.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/unpack_c10.Tpo" "$(DEPDIR)/unpack_c10.Plo"; else rm -f "$(DEPDIR)/unpack_c10.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_c10.c' object='unpack_c10.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_c10.lo `test -f '$(srcdir)/generated/unpack_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_c10.c + + unpack_c16.lo: $(srcdir)/generated/unpack_c16.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_c16.lo -MD -MP -MF "$(DEPDIR)/unpack_c16.Tpo" -c -o unpack_c16.lo `test -f '$(srcdir)/generated/unpack_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_c16.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/unpack_c16.Tpo" "$(DEPDIR)/unpack_c16.Plo"; else rm -f "$(DEPDIR)/unpack_c16.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_c16.c' object='unpack_c16.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_c16.lo `test -f '$(srcdir)/generated/unpack_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_c16.c + + spread_i1.lo: $(srcdir)/generated/spread_i1.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_i1.lo -MD -MP -MF "$(DEPDIR)/spread_i1.Tpo" -c -o spread_i1.lo `test -f '$(srcdir)/generated/spread_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i1.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/spread_i1.Tpo" "$(DEPDIR)/spread_i1.Plo"; else rm -f "$(DEPDIR)/spread_i1.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_i1.c' object='spread_i1.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_i1.lo `test -f '$(srcdir)/generated/spread_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i1.c + + spread_i2.lo: $(srcdir)/generated/spread_i2.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_i2.lo -MD -MP -MF "$(DEPDIR)/spread_i2.Tpo" -c -o spread_i2.lo `test -f '$(srcdir)/generated/spread_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i2.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/spread_i2.Tpo" "$(DEPDIR)/spread_i2.Plo"; else rm -f "$(DEPDIR)/spread_i2.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_i2.c' object='spread_i2.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_i2.lo `test -f '$(srcdir)/generated/spread_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i2.c + + spread_i4.lo: $(srcdir)/generated/spread_i4.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_i4.lo -MD -MP -MF "$(DEPDIR)/spread_i4.Tpo" -c -o spread_i4.lo `test -f '$(srcdir)/generated/spread_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i4.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/spread_i4.Tpo" "$(DEPDIR)/spread_i4.Plo"; else rm -f "$(DEPDIR)/spread_i4.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_i4.c' object='spread_i4.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_i4.lo `test -f '$(srcdir)/generated/spread_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i4.c + + spread_i8.lo: $(srcdir)/generated/spread_i8.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_i8.lo -MD -MP -MF "$(DEPDIR)/spread_i8.Tpo" -c -o spread_i8.lo `test -f '$(srcdir)/generated/spread_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i8.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/spread_i8.Tpo" "$(DEPDIR)/spread_i8.Plo"; else rm -f "$(DEPDIR)/spread_i8.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_i8.c' object='spread_i8.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_i8.lo `test -f '$(srcdir)/generated/spread_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i8.c + + spread_i16.lo: $(srcdir)/generated/spread_i16.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_i16.lo -MD -MP -MF "$(DEPDIR)/spread_i16.Tpo" -c -o spread_i16.lo `test -f '$(srcdir)/generated/spread_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i16.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/spread_i16.Tpo" "$(DEPDIR)/spread_i16.Plo"; else rm -f "$(DEPDIR)/spread_i16.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_i16.c' object='spread_i16.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_i16.lo `test -f '$(srcdir)/generated/spread_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i16.c + + spread_r4.lo: $(srcdir)/generated/spread_r4.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_r4.lo -MD -MP -MF "$(DEPDIR)/spread_r4.Tpo" -c -o spread_r4.lo `test -f '$(srcdir)/generated/spread_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_r4.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/spread_r4.Tpo" "$(DEPDIR)/spread_r4.Plo"; else rm -f "$(DEPDIR)/spread_r4.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_r4.c' object='spread_r4.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_r4.lo `test -f '$(srcdir)/generated/spread_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_r4.c + + spread_r8.lo: $(srcdir)/generated/spread_r8.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_r8.lo -MD -MP -MF "$(DEPDIR)/spread_r8.Tpo" -c -o spread_r8.lo `test -f '$(srcdir)/generated/spread_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_r8.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/spread_r8.Tpo" "$(DEPDIR)/spread_r8.Plo"; else rm -f "$(DEPDIR)/spread_r8.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_r8.c' object='spread_r8.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_r8.lo `test -f '$(srcdir)/generated/spread_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_r8.c + + spread_r10.lo: $(srcdir)/generated/spread_r10.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_r10.lo -MD -MP -MF "$(DEPDIR)/spread_r10.Tpo" -c -o spread_r10.lo `test -f '$(srcdir)/generated/spread_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_r10.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/spread_r10.Tpo" "$(DEPDIR)/spread_r10.Plo"; else rm -f "$(DEPDIR)/spread_r10.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_r10.c' object='spread_r10.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_r10.lo `test -f '$(srcdir)/generated/spread_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_r10.c + + spread_r16.lo: $(srcdir)/generated/spread_r16.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_r16.lo -MD -MP -MF "$(DEPDIR)/spread_r16.Tpo" -c -o spread_r16.lo `test -f '$(srcdir)/generated/spread_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_r16.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/spread_r16.Tpo" "$(DEPDIR)/spread_r16.Plo"; else rm -f "$(DEPDIR)/spread_r16.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_r16.c' object='spread_r16.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_r16.lo `test -f '$(srcdir)/generated/spread_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_r16.c + + spread_c4.lo: $(srcdir)/generated/spread_c4.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_c4.lo -MD -MP -MF "$(DEPDIR)/spread_c4.Tpo" -c -o spread_c4.lo `test -f '$(srcdir)/generated/spread_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_c4.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/spread_c4.Tpo" "$(DEPDIR)/spread_c4.Plo"; else rm -f "$(DEPDIR)/spread_c4.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_c4.c' object='spread_c4.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_c4.lo `test -f '$(srcdir)/generated/spread_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_c4.c + + spread_c8.lo: $(srcdir)/generated/spread_c8.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_c8.lo -MD -MP -MF "$(DEPDIR)/spread_c8.Tpo" -c -o spread_c8.lo `test -f '$(srcdir)/generated/spread_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_c8.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/spread_c8.Tpo" "$(DEPDIR)/spread_c8.Plo"; else rm -f "$(DEPDIR)/spread_c8.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_c8.c' object='spread_c8.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_c8.lo `test -f '$(srcdir)/generated/spread_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_c8.c + + spread_c10.lo: $(srcdir)/generated/spread_c10.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_c10.lo -MD -MP -MF "$(DEPDIR)/spread_c10.Tpo" -c -o spread_c10.lo `test -f '$(srcdir)/generated/spread_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_c10.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/spread_c10.Tpo" "$(DEPDIR)/spread_c10.Plo"; else rm -f "$(DEPDIR)/spread_c10.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_c10.c' object='spread_c10.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_c10.lo `test -f '$(srcdir)/generated/spread_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_c10.c + + spread_c16.lo: $(srcdir)/generated/spread_c16.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_c16.lo -MD -MP -MF "$(DEPDIR)/spread_c16.Tpo" -c -o spread_c16.lo `test -f '$(srcdir)/generated/spread_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_c16.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/spread_c16.Tpo" "$(DEPDIR)/spread_c16.Plo"; else rm -f "$(DEPDIR)/spread_c16.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_c16.c' object='spread_c16.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_c16.lo `test -f '$(srcdir)/generated/spread_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_c16.c + + cshift0_i1.lo: $(srcdir)/generated/cshift0_i1.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_i1.lo -MD -MP -MF "$(DEPDIR)/cshift0_i1.Tpo" -c -o cshift0_i1.lo `test -f '$(srcdir)/generated/cshift0_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i1.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_i1.Tpo" "$(DEPDIR)/cshift0_i1.Plo"; else rm -f "$(DEPDIR)/cshift0_i1.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_i1.c' object='cshift0_i1.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_i1.lo `test -f '$(srcdir)/generated/cshift0_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i1.c + + cshift0_i2.lo: $(srcdir)/generated/cshift0_i2.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_i2.lo -MD -MP -MF "$(DEPDIR)/cshift0_i2.Tpo" -c -o cshift0_i2.lo `test -f '$(srcdir)/generated/cshift0_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i2.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_i2.Tpo" "$(DEPDIR)/cshift0_i2.Plo"; else rm -f "$(DEPDIR)/cshift0_i2.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_i2.c' object='cshift0_i2.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_i2.lo `test -f '$(srcdir)/generated/cshift0_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i2.c + + cshift0_i4.lo: $(srcdir)/generated/cshift0_i4.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_i4.lo -MD -MP -MF "$(DEPDIR)/cshift0_i4.Tpo" -c -o cshift0_i4.lo `test -f '$(srcdir)/generated/cshift0_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i4.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_i4.Tpo" "$(DEPDIR)/cshift0_i4.Plo"; else rm -f "$(DEPDIR)/cshift0_i4.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_i4.c' object='cshift0_i4.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_i4.lo `test -f '$(srcdir)/generated/cshift0_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i4.c + + cshift0_i8.lo: $(srcdir)/generated/cshift0_i8.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_i8.lo -MD -MP -MF "$(DEPDIR)/cshift0_i8.Tpo" -c -o cshift0_i8.lo `test -f '$(srcdir)/generated/cshift0_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i8.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_i8.Tpo" "$(DEPDIR)/cshift0_i8.Plo"; else rm -f "$(DEPDIR)/cshift0_i8.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_i8.c' object='cshift0_i8.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_i8.lo `test -f '$(srcdir)/generated/cshift0_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i8.c + + cshift0_i16.lo: $(srcdir)/generated/cshift0_i16.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_i16.lo -MD -MP -MF "$(DEPDIR)/cshift0_i16.Tpo" -c -o cshift0_i16.lo `test -f '$(srcdir)/generated/cshift0_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i16.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_i16.Tpo" "$(DEPDIR)/cshift0_i16.Plo"; else rm -f "$(DEPDIR)/cshift0_i16.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_i16.c' object='cshift0_i16.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_i16.lo `test -f '$(srcdir)/generated/cshift0_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i16.c + + cshift0_r4.lo: $(srcdir)/generated/cshift0_r4.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_r4.lo -MD -MP -MF "$(DEPDIR)/cshift0_r4.Tpo" -c -o cshift0_r4.lo `test -f '$(srcdir)/generated/cshift0_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r4.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_r4.Tpo" "$(DEPDIR)/cshift0_r4.Plo"; else rm -f "$(DEPDIR)/cshift0_r4.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_r4.c' object='cshift0_r4.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_r4.lo `test -f '$(srcdir)/generated/cshift0_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r4.c + + cshift0_r8.lo: $(srcdir)/generated/cshift0_r8.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_r8.lo -MD -MP -MF "$(DEPDIR)/cshift0_r8.Tpo" -c -o cshift0_r8.lo `test -f '$(srcdir)/generated/cshift0_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r8.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_r8.Tpo" "$(DEPDIR)/cshift0_r8.Plo"; else rm -f "$(DEPDIR)/cshift0_r8.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_r8.c' object='cshift0_r8.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_r8.lo `test -f '$(srcdir)/generated/cshift0_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r8.c + + cshift0_r10.lo: $(srcdir)/generated/cshift0_r10.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_r10.lo -MD -MP -MF "$(DEPDIR)/cshift0_r10.Tpo" -c -o cshift0_r10.lo `test -f '$(srcdir)/generated/cshift0_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r10.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_r10.Tpo" "$(DEPDIR)/cshift0_r10.Plo"; else rm -f "$(DEPDIR)/cshift0_r10.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_r10.c' object='cshift0_r10.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_r10.lo `test -f '$(srcdir)/generated/cshift0_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r10.c + + cshift0_r16.lo: $(srcdir)/generated/cshift0_r16.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_r16.lo -MD -MP -MF "$(DEPDIR)/cshift0_r16.Tpo" -c -o cshift0_r16.lo `test -f '$(srcdir)/generated/cshift0_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r16.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_r16.Tpo" "$(DEPDIR)/cshift0_r16.Plo"; else rm -f "$(DEPDIR)/cshift0_r16.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_r16.c' object='cshift0_r16.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_r16.lo `test -f '$(srcdir)/generated/cshift0_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r16.c + + cshift0_c4.lo: $(srcdir)/generated/cshift0_c4.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_c4.lo -MD -MP -MF "$(DEPDIR)/cshift0_c4.Tpo" -c -o cshift0_c4.lo `test -f '$(srcdir)/generated/cshift0_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c4.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_c4.Tpo" "$(DEPDIR)/cshift0_c4.Plo"; else rm -f "$(DEPDIR)/cshift0_c4.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_c4.c' object='cshift0_c4.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_c4.lo `test -f '$(srcdir)/generated/cshift0_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c4.c + + cshift0_c8.lo: $(srcdir)/generated/cshift0_c8.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_c8.lo -MD -MP -MF "$(DEPDIR)/cshift0_c8.Tpo" -c -o cshift0_c8.lo `test -f '$(srcdir)/generated/cshift0_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c8.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_c8.Tpo" "$(DEPDIR)/cshift0_c8.Plo"; else rm -f "$(DEPDIR)/cshift0_c8.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_c8.c' object='cshift0_c8.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_c8.lo `test -f '$(srcdir)/generated/cshift0_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c8.c + + cshift0_c10.lo: $(srcdir)/generated/cshift0_c10.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_c10.lo -MD -MP -MF "$(DEPDIR)/cshift0_c10.Tpo" -c -o cshift0_c10.lo `test -f '$(srcdir)/generated/cshift0_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c10.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_c10.Tpo" "$(DEPDIR)/cshift0_c10.Plo"; else rm -f "$(DEPDIR)/cshift0_c10.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_c10.c' object='cshift0_c10.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_c10.lo `test -f '$(srcdir)/generated/cshift0_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c10.c + + cshift0_c16.lo: $(srcdir)/generated/cshift0_c16.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_c16.lo -MD -MP -MF "$(DEPDIR)/cshift0_c16.Tpo" -c -o cshift0_c16.lo `test -f '$(srcdir)/generated/cshift0_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c16.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_c16.Tpo" "$(DEPDIR)/cshift0_c16.Plo"; else rm -f "$(DEPDIR)/cshift0_c16.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_c16.c' object='cshift0_c16.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_c16.lo `test -f '$(srcdir)/generated/cshift0_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c16.c + close.lo: io/close.c @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT close.lo -MD -MP -MF "$(DEPDIR)/close.Tpo" -c -o close.lo `test -f 'io/close.c' || echo '$(srcdir)/'`io/close.c; \ @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/close.Tpo" "$(DEPDIR)/close.Plo"; else rm -f "$(DEPDIR)/close.Tpo"; exit 1; fi *************** write.lo: io/write.c *** 4586,4591 **** --- 5284,5296 ---- @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o write.lo `test -f 'io/write.c' || echo '$(srcdir)/'`io/write.c + fbuf.lo: io/fbuf.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT fbuf.lo -MD -MP -MF "$(DEPDIR)/fbuf.Tpo" -c -o fbuf.lo `test -f 'io/fbuf.c' || echo '$(srcdir)/'`io/fbuf.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/fbuf.Tpo" "$(DEPDIR)/fbuf.Plo"; else rm -f "$(DEPDIR)/fbuf.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/fbuf.c' object='fbuf.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fbuf.lo `test -f 'io/fbuf.c' || echo '$(srcdir)/'`io/fbuf.c + associated.lo: intrinsics/associated.c @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT associated.lo -MD -MP -MF "$(DEPDIR)/associated.Tpo" -c -o associated.lo `test -f 'intrinsics/associated.c' || echo '$(srcdir)/'`intrinsics/associated.c; \ @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/associated.Tpo" "$(DEPDIR)/associated.Plo"; else rm -f "$(DEPDIR)/associated.Tpo"; exit 1; fi *************** eoshift2.lo: intrinsics/eoshift2.c *** 4698,4703 **** --- 5403,5415 ---- @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift2.lo `test -f 'intrinsics/eoshift2.c' || echo '$(srcdir)/'`intrinsics/eoshift2.c + erfc_scaled.lo: intrinsics/erfc_scaled.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT erfc_scaled.lo -MD -MP -MF "$(DEPDIR)/erfc_scaled.Tpo" -c -o erfc_scaled.lo `test -f 'intrinsics/erfc_scaled.c' || echo '$(srcdir)/'`intrinsics/erfc_scaled.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/erfc_scaled.Tpo" "$(DEPDIR)/erfc_scaled.Plo"; else rm -f "$(DEPDIR)/erfc_scaled.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/erfc_scaled.c' object='erfc_scaled.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o erfc_scaled.lo `test -f 'intrinsics/erfc_scaled.c' || echo '$(srcdir)/'`intrinsics/erfc_scaled.c + etime.lo: intrinsics/etime.c @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT etime.lo -MD -MP -MF "$(DEPDIR)/etime.Tpo" -c -o etime.lo `test -f 'intrinsics/etime.c' || echo '$(srcdir)/'`intrinsics/etime.c; \ @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/etime.Tpo" "$(DEPDIR)/etime.Plo"; else rm -f "$(DEPDIR)/etime.Tpo"; exit 1; fi *************** perror.lo: intrinsics/perror.c *** 4831,4836 **** --- 5543,5555 ---- @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o perror.lo `test -f 'intrinsics/perror.c' || echo '$(srcdir)/'`intrinsics/perror.c + selected_char_kind.lo: intrinsics/selected_char_kind.c + @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT selected_char_kind.lo -MD -MP -MF "$(DEPDIR)/selected_char_kind.Tpo" -c -o selected_char_kind.lo `test -f 'intrinsics/selected_char_kind.c' || echo '$(srcdir)/'`intrinsics/selected_char_kind.c; \ + @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/selected_char_kind.Tpo" "$(DEPDIR)/selected_char_kind.Plo"; else rm -f "$(DEPDIR)/selected_char_kind.Tpo"; exit 1; fi + @AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/selected_char_kind.c' object='selected_char_kind.lo' libtool=yes @AMDEPBACKSLASH@ + @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ + @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o selected_char_kind.lo `test -f 'intrinsics/selected_char_kind.c' || echo '$(srcdir)/'`intrinsics/selected_char_kind.c + signal.lo: intrinsics/signal.c @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT signal.lo -MD -MP -MF "$(DEPDIR)/signal.Tpo" -c -o signal.lo `test -f 'intrinsics/signal.c' || echo '$(srcdir)/'`intrinsics/signal.c; \ @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/signal.Tpo" "$(DEPDIR)/signal.Plo"; else rm -f "$(DEPDIR)/signal.Tpo"; exit 1; fi *************** fpu-target.h: $(srcdir)/$(FPU_HOST_HEADE *** 5402,5407 **** --- 6121,6129 ---- @MAINTAINER_MODE_TRUE@$(i_eoshift3_c): m4/eoshift3.m4 $(I_M4_DEPS) @MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 eoshift3.m4 > $@ + @MAINTAINER_MODE_TRUE@$(i_cshift0_c): m4/cshift0.m4 $(I_M4_DEPS) + @MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 cshift0.m4 > $@ + @MAINTAINER_MODE_TRUE@$(i_cshift1_c): m4/cshift1.m4 $(I_M4_DEPS) @MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 cshift1.m4 > $@ *************** fpu-target.h: $(srcdir)/$(FPU_HOST_HEADE *** 5432,5437 **** --- 6154,6168 ---- @MAINTAINER_MODE_TRUE@$(i_pow_c): m4/pow.m4 $(I_M4_DEPS) @MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 pow.m4 > $@ + @MAINTAINER_MODE_TRUE@$(i_pack_c): m4/pack.m4 $(I_M4_DEPS) + @MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 pack.m4 > $@ + + @MAINTAINER_MODE_TRUE@$(i_unpack_c): m4/unpack.m4 $(I_M4_DEPS) + @MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 unpack.m4 > $@ + + @MAINTAINER_MODE_TRUE@$(i_spread_c): m4/spread.m4 $(I_M4_DEPS) + @MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 spread.m4 > $@ + @MAINTAINER_MODE_TRUE@$(gfor_built_specific_src): m4/specific.m4 m4/head.m4 @MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 specific.m4 > $@ diff -Nrcpad gcc-4.3.3/libgfortran/acinclude.m4 gcc-4.4.0/libgfortran/acinclude.m4 *** gcc-4.3.3/libgfortran/acinclude.m4 Wed Dec 31 15:42:12 2008 --- gcc-4.4.0/libgfortran/acinclude.m4 Mon Dec 29 20:10:00 2008 *************** AC_DEFUN([AC_PROG_LD]) *** 30,43 **** dnl Check whether the target supports hidden visibility. AC_DEFUN([LIBGFOR_CHECK_ATTRIBUTE_VISIBILITY], [ AC_CACHE_CHECK([whether the target supports hidden visibility], ! have_attribute_visibility, [ save_CFLAGS="$CFLAGS" CFLAGS="$CFLAGS -Werror" AC_TRY_COMPILE([void __attribute__((visibility("hidden"))) foo(void) { }], ! [], have_attribute_visibility=yes, ! have_attribute_visibility=no) CFLAGS="$save_CFLAGS"]) ! if test $have_attribute_visibility = yes; then AC_DEFINE(HAVE_ATTRIBUTE_VISIBILITY, 1, [Define to 1 if the target supports __attribute__((visibility(...))).]) fi]) --- 30,43 ---- dnl Check whether the target supports hidden visibility. AC_DEFUN([LIBGFOR_CHECK_ATTRIBUTE_VISIBILITY], [ AC_CACHE_CHECK([whether the target supports hidden visibility], ! libgfor_cv_have_attribute_visibility, [ save_CFLAGS="$CFLAGS" CFLAGS="$CFLAGS -Werror" AC_TRY_COMPILE([void __attribute__((visibility("hidden"))) foo(void) { }], ! [], libgfor_cv_have_attribute_visibility=yes, ! libgfor_cv_have_attribute_visibility=no) CFLAGS="$save_CFLAGS"]) ! if test $libgfor_cv_have_attribute_visibility = yes; then AC_DEFINE(HAVE_ATTRIBUTE_VISIBILITY, 1, [Define to 1 if the target supports __attribute__((visibility(...))).]) fi]) *************** AC_DEFUN([LIBGFOR_CHECK_ATTRIBUTE_VISIBI *** 45,58 **** dnl Check whether the target supports dllexport AC_DEFUN([LIBGFOR_CHECK_ATTRIBUTE_DLLEXPORT], [ AC_CACHE_CHECK([whether the target supports dllexport], ! have_attribute_dllexport, [ save_CFLAGS="$CFLAGS" CFLAGS="$CFLAGS -Werror" AC_TRY_COMPILE([void __attribute__((dllexport)) foo(void) { }], ! [], have_attribute_dllexport=yes, ! have_attribute_dllexport=no) CFLAGS="$save_CFLAGS"]) ! if test $have_attribute_dllexport = yes; then AC_DEFINE(HAVE_ATTRIBUTE_DLLEXPORT, 1, [Define to 1 if the target supports __attribute__((dllexport)).]) fi]) --- 45,58 ---- dnl Check whether the target supports dllexport AC_DEFUN([LIBGFOR_CHECK_ATTRIBUTE_DLLEXPORT], [ AC_CACHE_CHECK([whether the target supports dllexport], ! libgfor_cv_have_attribute_dllexport, [ save_CFLAGS="$CFLAGS" CFLAGS="$CFLAGS -Werror" AC_TRY_COMPILE([void __attribute__((dllexport)) foo(void) { }], ! [], libgfor_cv_have_attribute_dllexport=yes, ! libgfor_cv_have_attribute_dllexport=no) CFLAGS="$save_CFLAGS"]) ! if test $libgfor_cv_have_attribute_dllexport = yes; then AC_DEFINE(HAVE_ATTRIBUTE_DLLEXPORT, 1, [Define to 1 if the target supports __attribute__((dllexport)).]) fi]) *************** AC_DEFUN([LIBGFOR_CHECK_ATTRIBUTE_DLLEXP *** 60,71 **** dnl Check whether the target supports symbol aliases. AC_DEFUN([LIBGFOR_CHECK_ATTRIBUTE_ALIAS], [ AC_CACHE_CHECK([whether the target supports symbol aliases], ! have_attribute_alias, [ AC_TRY_LINK([ void foo(void) { } extern void bar(void) __attribute__((alias("foo")));], ! [bar();], have_attribute_alias=yes, have_attribute_alias=no)]) ! if test $have_attribute_alias = yes; then AC_DEFINE(HAVE_ATTRIBUTE_ALIAS, 1, [Define to 1 if the target supports __attribute__((alias(...))).]) fi]) --- 60,71 ---- dnl Check whether the target supports symbol aliases. AC_DEFUN([LIBGFOR_CHECK_ATTRIBUTE_ALIAS], [ AC_CACHE_CHECK([whether the target supports symbol aliases], ! libgfor_cv_have_attribute_alias, [ AC_TRY_LINK([ void foo(void) { } extern void bar(void) __attribute__((alias("foo")));], ! [bar();], libgfor_cv_have_attribute_alias=yes, libgfor_cv_have_attribute_alias=no)]) ! if test $libgfor_cv_have_attribute_alias = yes; then AC_DEFINE(HAVE_ATTRIBUTE_ALIAS, 1, [Define to 1 if the target supports __attribute__((alias(...))).]) fi]) *************** extern void bar(void) __attribute__((ali *** 73,84 **** dnl Check whether the target supports __sync_fetch_and_add. AC_DEFUN([LIBGFOR_CHECK_SYNC_FETCH_AND_ADD], [ AC_CACHE_CHECK([whether the target supports __sync_fetch_and_add], ! have_sync_fetch_and_add, [ AC_TRY_LINK([int foovar = 0;], [ if (foovar <= 0) return __sync_fetch_and_add (&foovar, 1); if (foovar > 10) return __sync_add_and_fetch (&foovar, -1);], ! have_sync_fetch_and_add=yes, have_sync_fetch_and_add=no)]) ! if test $have_sync_fetch_and_add = yes; then AC_DEFINE(HAVE_SYNC_FETCH_AND_ADD, 1, [Define to 1 if the target supports __sync_fetch_and_add]) fi]) --- 73,84 ---- dnl Check whether the target supports __sync_fetch_and_add. AC_DEFUN([LIBGFOR_CHECK_SYNC_FETCH_AND_ADD], [ AC_CACHE_CHECK([whether the target supports __sync_fetch_and_add], ! libgfor_cv_have_sync_fetch_and_add, [ AC_TRY_LINK([int foovar = 0;], [ if (foovar <= 0) return __sync_fetch_and_add (&foovar, 1); if (foovar > 10) return __sync_add_and_fetch (&foovar, -1);], ! libgfor_cv_have_sync_fetch_and_add=yes, libgfor_cv_have_sync_fetch_and_add=no)]) ! if test $libgfor_cv_have_sync_fetch_and_add = yes; then AC_DEFINE(HAVE_SYNC_FETCH_AND_ADD, 1, [Define to 1 if the target supports __sync_fetch_and_add]) fi]) *************** if (foovar > 10) return __sync_add_and_f *** 86,95 **** dnl Check if threads are supported. AC_DEFUN([LIBGFOR_CHECK_GTHR_DEFAULT], [ AC_CACHE_CHECK([configured target thread model], ! target_thread_file, [ ! target_thread_file=`$CC -v 2>&1 | sed -n 's/^Thread model: //p'`]) ! if test $target_thread_file != single; then AC_DEFINE(HAVE_GTHR_DEFAULT, 1, [Define if the compiler has a thread header that is non single.]) fi]) --- 86,95 ---- dnl Check if threads are supported. AC_DEFUN([LIBGFOR_CHECK_GTHR_DEFAULT], [ AC_CACHE_CHECK([configured target thread model], ! libgfor_cv_target_thread_file, [ ! libgfor_cv_target_thread_file=`$CC -v 2>&1 | sed -n 's/^Thread model: //p'`]) ! if test $libgfor_cv_target_thread_file != single; then AC_DEFINE(HAVE_GTHR_DEFAULT, 1, [Define if the compiler has a thread header that is non single.]) fi]) *************** target_thread_file=`$CC -v 2>&1 | sed -n *** 97,109 **** dnl Check for pragma weak. AC_DEFUN([LIBGFOR_GTHREAD_WEAK], [ AC_CACHE_CHECK([whether pragma weak works], ! have_pragma_weak, [ gfor_save_CFLAGS="$CFLAGS" CFLAGS="$CFLAGS -Wunknown-pragmas" AC_TRY_COMPILE([void foo (void); #pragma weak foo], [if (foo) foo ();], ! have_pragma_weak=yes, have_pragma_weak=no)]) ! if test $have_pragma_weak = yes; then AC_DEFINE(SUPPORTS_WEAK, 1, [Define to 1 if the target supports #pragma weak]) fi --- 97,109 ---- dnl Check for pragma weak. AC_DEFUN([LIBGFOR_GTHREAD_WEAK], [ AC_CACHE_CHECK([whether pragma weak works], ! libgfor_cv_have_pragma_weak, [ gfor_save_CFLAGS="$CFLAGS" CFLAGS="$CFLAGS -Wunknown-pragmas" AC_TRY_COMPILE([void foo (void); #pragma weak foo], [if (foo) foo ();], ! libgfor_cv_have_pragma_weak=yes, libgfor_cv_have_pragma_weak=no)]) ! if test $libgfor_cv_have_pragma_weak = yes; then AC_DEFINE(SUPPORTS_WEAK, 1, [Define to 1 if the target supports #pragma weak]) fi *************** AC_DEFUN([LIBGFOR_GTHREAD_WEAK], [ *** 117,123 **** dnl Check whether target can unlink a file still open. AC_DEFUN([LIBGFOR_CHECK_UNLINK_OPEN_FILE], [ AC_CACHE_CHECK([whether the target can unlink an open file], ! have_unlink_open_file, [ AC_TRY_RUN([ #include #include --- 117,123 ---- dnl Check whether target can unlink a file still open. AC_DEFUN([LIBGFOR_CHECK_UNLINK_OPEN_FILE], [ AC_CACHE_CHECK([whether the target can unlink an open file], ! libgfor_cv_have_unlink_open_file, [ AC_TRY_RUN([ #include #include *************** int main () *** 140,158 **** return 0; else return 1; ! }], have_unlink_open_file=yes, have_unlink_open_file=no, [ case "${target}" in ! *mingw*) have_unlink_open_file=no ;; ! *) have_unlink_open_file=yes;; esac])]) ! if test x"$have_unlink_open_file" = xyes; then AC_DEFINE(HAVE_UNLINK_OPEN_FILE, 1, [Define if target can unlink open files.]) fi]) dnl Check whether CRLF is the line terminator AC_DEFUN([LIBGFOR_CHECK_CRLF], [ AC_CACHE_CHECK([whether the target has CRLF as line terminator], ! have_crlf, [ AC_TRY_RUN([ /* This test program should exit with status 0 if system uses a CRLF as line terminator, and status 1 otherwise. --- 140,158 ---- return 0; else return 1; ! }], libgfor_cv_have_unlink_open_file=yes, libgfor_cv_have_unlink_open_file=no, [ case "${target}" in ! *mingw*) libgfor_cv_have_unlink_open_file=no ;; ! *) libgfor_cv_have_unlink_open_file=yes;; esac])]) ! if test x"$libgfor_cv_have_unlink_open_file" = xyes; then AC_DEFINE(HAVE_UNLINK_OPEN_FILE, 1, [Define if target can unlink open files.]) fi]) dnl Check whether CRLF is the line terminator AC_DEFUN([LIBGFOR_CHECK_CRLF], [ AC_CACHE_CHECK([whether the target has CRLF as line terminator], ! libgfor_cv_have_crlf, [ AC_TRY_RUN([ /* This test program should exit with status 0 if system uses a CRLF as line terminator, and status 1 otherwise. *************** int main () *** 187,198 **** else exit(1); #endif ! }], have_crlf=yes, have_crlf=no, [ case "${target}" in ! *mingw*) have_crlf=yes ;; ! *) have_crlf=no;; esac])]) ! if test x"$have_crlf" = xyes; then AC_DEFINE(HAVE_CRLF, 1, [Define if CRLF is line terminator.]) fi]) --- 187,198 ---- else exit(1); #endif ! }], libgfor_cv_have_crlf=yes, libgfor_cv_have_crlf=no, [ case "${target}" in ! *mingw*) libgfor_cv_have_crlf=yes ;; ! *) libgfor_cv_have_crlf=no;; esac])]) ! if test x"$libgfor_cv_have_crlf" = xyes; then AC_DEFINE(HAVE_CRLF, 1, [Define if CRLF is line terminator.]) fi]) *************** dnl Check whether isfinite is broken. *** 200,212 **** dnl The most common problem is that it does not work on long doubles. AC_DEFUN([LIBGFOR_CHECK_FOR_BROKEN_ISFINITE], [ AC_CACHE_CHECK([whether isfinite is broken], ! have_broken_isfinite, [ libgfor_check_for_broken_isfinite_save_LIBS=$LIBS LIBS="$LIBS -lm" AC_TRY_RUN([ - #ifdef HAVE_MATH_H #include - #endif #include int main () { --- 200,210 ---- dnl The most common problem is that it does not work on long doubles. AC_DEFUN([LIBGFOR_CHECK_FOR_BROKEN_ISFINITE], [ AC_CACHE_CHECK([whether isfinite is broken], ! libgfor_cv_have_broken_isfinite, [ libgfor_check_for_broken_isfinite_save_LIBS=$LIBS LIBS="$LIBS -lm" AC_TRY_RUN([ #include #include int main () { *************** int main () *** 219,231 **** #endif #endif return 0; ! }], have_broken_isfinite=no, have_broken_isfinite=yes, [ case "${target}" in ! hppa*-*-hpux*) have_broken_isfinite=yes ;; ! *) have_broken_isfinite=no ;; esac])] LIBS=$libgfor_check_for_broken_isfinite_save_LIBS) ! if test x"$have_broken_isfinite" = xyes; then AC_DEFINE(HAVE_BROKEN_ISFINITE, 1, [Define if isfinite is broken.]) fi]) --- 217,229 ---- #endif #endif return 0; ! }], libgfor_cv_have_broken_isfinite=no, libgfor_cv_have_broken_isfinite=yes, [ case "${target}" in ! hppa*-*-hpux*) libgfor_cv_have_broken_isfinite=yes ;; ! *) libgfor_cv_have_broken_isfinite=no ;; esac])] LIBS=$libgfor_check_for_broken_isfinite_save_LIBS) ! if test x"$libgfor_cv_have_broken_isfinite" = xyes; then AC_DEFINE(HAVE_BROKEN_ISFINITE, 1, [Define if isfinite is broken.]) fi]) *************** dnl Check whether isnan is broken. *** 233,245 **** dnl The most common problem is that it does not work on long doubles. AC_DEFUN([LIBGFOR_CHECK_FOR_BROKEN_ISNAN], [ AC_CACHE_CHECK([whether isnan is broken], ! have_broken_isnan, [ libgfor_check_for_broken_isnan_save_LIBS=$LIBS LIBS="$LIBS -lm" AC_TRY_RUN([ - #ifdef HAVE_MATH_H #include - #endif #include int main () { --- 231,241 ---- dnl The most common problem is that it does not work on long doubles. AC_DEFUN([LIBGFOR_CHECK_FOR_BROKEN_ISNAN], [ AC_CACHE_CHECK([whether isnan is broken], ! libgfor_cv_have_broken_isnan, [ libgfor_check_for_broken_isnan_save_LIBS=$LIBS LIBS="$LIBS -lm" AC_TRY_RUN([ #include #include int main () { *************** int main () *** 270,282 **** #endif #endif return 0; ! }], have_broken_isnan=no, have_broken_isnan=yes, [ case "${target}" in ! hppa*-*-hpux*) have_broken_isnan=yes ;; ! *) have_broken_isnan=no ;; esac])] LIBS=$libgfor_check_for_broken_isnan_save_LIBS) ! if test x"$have_broken_isnan" = xyes; then AC_DEFINE(HAVE_BROKEN_ISNAN, 1, [Define if isnan is broken.]) fi]) --- 266,278 ---- #endif #endif return 0; ! }], libgfor_cv_have_broken_isnan=no, libgfor_cv_have_broken_isnan=yes, [ case "${target}" in ! hppa*-*-hpux*) libgfor_cv_have_broken_isnan=yes ;; ! *) libgfor_cv_have_broken_isnan=no ;; esac])] LIBS=$libgfor_check_for_broken_isnan_save_LIBS) ! if test x"$libgfor_cv_have_broken_isnan" = xyes; then AC_DEFINE(HAVE_BROKEN_ISNAN, 1, [Define if isnan is broken.]) fi]) *************** dnl Check whether fpclassify is broken. *** 284,296 **** dnl The most common problem is that it does not work on long doubles. AC_DEFUN([LIBGFOR_CHECK_FOR_BROKEN_FPCLASSIFY], [ AC_CACHE_CHECK([whether fpclassify is broken], ! have_broken_fpclassify, [ libgfor_check_for_broken_fpclassify_save_LIBS=$LIBS LIBS="$LIBS -lm" AC_TRY_RUN([ - #ifdef HAVE_MATH_H #include - #endif #include int main () { --- 280,290 ---- dnl The most common problem is that it does not work on long doubles. AC_DEFUN([LIBGFOR_CHECK_FOR_BROKEN_FPCLASSIFY], [ AC_CACHE_CHECK([whether fpclassify is broken], ! libgfor_cv_have_broken_fpclassify, [ libgfor_check_for_broken_fpclassify_save_LIBS=$LIBS LIBS="$LIBS -lm" AC_TRY_RUN([ #include #include int main () { *************** int main () *** 305,317 **** #endif #endif return 0; ! }], have_broken_fpclassify=no, have_broken_fpclassify=yes, [ case "${target}" in ! hppa*-*-hpux*) have_broken_fpclassify=yes ;; ! *) have_broken_fpclassify=no ;; esac])] LIBS=$libgfor_check_for_broken_fpclassify_save_LIBS) ! if test x"$have_broken_fpclassify" = xyes; then AC_DEFINE(HAVE_BROKEN_FPCLASSIFY, 1, [Define if fpclassify is broken.]) fi]) --- 299,311 ---- #endif #endif return 0; ! }], libgfor_cv_have_broken_fpclassify=no, libgfor_cv_have_broken_fpclassify=yes, [ case "${target}" in ! hppa*-*-hpux*) libgfor_cv_have_broken_fpclassify=yes ;; ! *) libgfor_cv_have_broken_fpclassify=no ;; esac])] LIBS=$libgfor_check_for_broken_fpclassify_save_LIBS) ! if test x"$libgfor_cv_have_broken_fpclassify" = xyes; then AC_DEFINE(HAVE_BROKEN_FPCLASSIFY, 1, [Define if fpclassify is broken.]) fi]) *************** dnl identify the file within the system. *** 320,326 **** dnl systems; it is known to be false on mingw32. AC_DEFUN([LIBGFOR_CHECK_WORKING_STAT], [ AC_CACHE_CHECK([whether the target stat is reliable], ! have_working_stat, [ AC_TRY_RUN([ #include #include --- 314,320 ---- dnl systems; it is known to be false on mingw32. AC_DEFUN([LIBGFOR_CHECK_WORKING_STAT], [ AC_CACHE_CHECK([whether the target stat is reliable], ! libgfor_cv_have_working_stat, [ AC_TRY_RUN([ #include #include *************** int main () *** 341,358 **** fclose(f); fclose(g); return 0; ! }], have_working_stat=yes, have_working_stat=no, [ case "${target}" in ! *mingw*) have_working_stat=no ;; ! *) have_working_stat=yes;; esac])]) ! if test x"$have_working_stat" = xyes; then AC_DEFINE(HAVE_WORKING_STAT, 1, [Define if target has a reliable stat.]) fi]) dnl Checks for fpsetmask function. AC_DEFUN([LIBGFOR_CHECK_FPSETMASK], [ ! AC_CACHE_CHECK([whether fpsetmask is present], have_fpsetmask, [ AC_TRY_LINK([ #if HAVE_FLOATINGPOINT_H # include --- 335,352 ---- fclose(f); fclose(g); return 0; ! }], libgfor_cv_have_working_stat=yes, libgfor_cv_have_working_stat=no, [ case "${target}" in ! *mingw*) libgfor_cv_have_working_stat=no ;; ! *) libgfor_cv_have_working_stat=yes;; esac])]) ! if test x"$libgfor_cv_have_working_stat" = xyes; then AC_DEFINE(HAVE_WORKING_STAT, 1, [Define if target has a reliable stat.]) fi]) dnl Checks for fpsetmask function. AC_DEFUN([LIBGFOR_CHECK_FPSETMASK], [ ! AC_CACHE_CHECK([whether fpsetmask is present], libgfor_cv_have_fpsetmask, [ AC_TRY_LINK([ #if HAVE_FLOATINGPOINT_H # include *************** AC_DEFUN([LIBGFOR_CHECK_FPSETMASK], [ *** 360,384 **** #if HAVE_IEEEFP_H # include #endif /* HAVE_IEEEFP_H */],[fpsetmask(0);], ! eval "have_fpsetmask=yes", eval "have_fpsetmask=no") ]) ! if test x"$have_fpsetmask" = xyes; then AC_DEFINE(HAVE_FPSETMASK, 1, [Define if you have fpsetmask.]) fi ]) dnl Check whether we have a mingw that provides a __mingw_snprintf function AC_DEFUN([LIBGFOR_CHECK_MINGW_SNPRINTF], [ ! AC_CACHE_CHECK([whether __mingw_snprintf is present], have_mingw_snprintf, [ AC_TRY_LINK([ #include extern int __mingw_snprintf (char *, size_t, const char *, ...); ],[ __mingw_snprintf (NULL, 0, "%d\n", 1); ], ! eval "have_mingw_snprintf=yes", eval "have_mingw_snprintf=no") ]) ! if test x"$have_mingw_snprintf" = xyes; then AC_DEFINE(HAVE_MINGW_SNPRINTF, 1, [Define if you have __mingw_snprintf.]) fi ]) --- 354,378 ---- #if HAVE_IEEEFP_H # include #endif /* HAVE_IEEEFP_H */],[fpsetmask(0);], ! eval "libgfor_cv_have_fpsetmask=yes", eval "libgfor_cv_have_fpsetmask=no") ]) ! if test x"$libgfor_cv_have_fpsetmask" = xyes; then AC_DEFINE(HAVE_FPSETMASK, 1, [Define if you have fpsetmask.]) fi ]) dnl Check whether we have a mingw that provides a __mingw_snprintf function AC_DEFUN([LIBGFOR_CHECK_MINGW_SNPRINTF], [ ! AC_CACHE_CHECK([whether __mingw_snprintf is present], libgfor_cv_have_mingw_snprintf, [ AC_TRY_LINK([ #include extern int __mingw_snprintf (char *, size_t, const char *, ...); ],[ __mingw_snprintf (NULL, 0, "%d\n", 1); ], ! eval "libgfor_cv_have_mingw_snprintf=yes", eval "libgfor_cv_have_mingw_snprintf=no") ]) ! if test x"$libgfor_cv_have_mingw_snprintf" = xyes; then AC_DEFINE(HAVE_MINGW_SNPRINTF, 1, [Define if you have __mingw_snprintf.]) fi ]) diff -Nrcpad gcc-4.3.3/libgfortran/aclocal.m4 gcc-4.4.0/libgfortran/aclocal.m4 *** gcc-4.3.3/libgfortran/aclocal.m4 Sat Jan 24 10:32:29 2009 --- gcc-4.4.0/libgfortran/aclocal.m4 Tue Apr 21 09:08:08 2009 *************** AC_SUBST([am__untar]) *** 859,864 **** --- 859,866 ---- m4_include([../config/depstand.m4]) m4_include([../config/lead-dot.m4]) m4_include([../config/multi.m4]) + m4_include([../config/override.m4]) + m4_include([../config/proginstall.m4]) m4_include([../config/stdint.m4]) m4_include([../ltoptions.m4]) m4_include([../ltsugar.m4]) diff -Nrcpad gcc-4.3.3/libgfortran/c99_protos.h gcc-4.4.0/libgfortran/c99_protos.h *** gcc-4.3.3/libgfortran/c99_protos.h Fri Nov 16 22:31:28 2007 --- gcc-4.4.0/libgfortran/c99_protos.h Thu Apr 9 23:23:07 2009 *************** *** 1,30 **** /* Declarations of various C99 functions ! Copyright (C) 2004, 2006, 2007 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). ! Libgfortran is free software; you can redistribute it and/or ! modify it under the terms of the GNU Lesser General Public ! License as published by the Free Software Foundation; either ! version 2.1 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Lesser General Public License for more details. ! ! You should have received a copy of the GNU Lesser General Public ! License along with libgfortran; see the file COPYING.LIB. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ ! /* As a special exception, if you link this library with other files, ! some of which are compiled with GCC, to produce an executable, ! this library does not by itself cause the resulting executable ! to be covered by the GNU General Public License. ! This exception does not however invalidate any other reasons why ! the executable file might be covered by the GNU General Public License. */ #ifndef C99_PROTOS_H #define C99_PROTOS_H 1 --- 1,26 ---- /* Declarations of various C99 functions ! Copyright (C) 2004, 2006, 2007, 2009 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). ! Libgfortran is free software; you can redistribute it and/or modify ! it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) ! any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ #ifndef C99_PROTOS_H #define C99_PROTOS_H 1 diff -Nrcpad gcc-4.3.3/libgfortran/config/fpu-387.h gcc-4.4.0/libgfortran/config/fpu-387.h *** gcc-4.3.3/libgfortran/config/fpu-387.h Fri Sep 7 09:34:36 2007 --- gcc-4.4.0/libgfortran/config/fpu-387.h Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* FPU-related code for x86 and x86_64 processors. ! Copyright 2005, 2007 Free Software Foundation, Inc. Contributed by Francois-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* FPU-related code for x86 and x86_64 processors. ! Copyright 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Francois-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #ifndef __x86_64__ #include "cpuid.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #ifndef __x86_64__ #include "cpuid.h" diff -Nrcpad gcc-4.3.3/libgfortran/config/fpu-aix.h gcc-4.4.0/libgfortran/config/fpu-aix.h *** gcc-4.3.3/libgfortran/config/fpu-aix.h Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/config/fpu-aix.h Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* AIX FPU-related code. ! Copyright 2005, 2007 Free Software Foundation, Inc. Contributed by Francois-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* AIX FPU-related code. ! Copyright 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Francois-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ /* FPU-related code for AIX. */ --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ /* FPU-related code for AIX. */ diff -Nrcpad gcc-4.3.3/libgfortran/config/fpu-generic.h gcc-4.4.0/libgfortran/config/fpu-generic.h *** gcc-4.3.3/libgfortran/config/fpu-generic.h Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/config/fpu-generic.h Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Fallback FPU-related code (for systems not otherwise supported). ! Copyright 2005, 2007 Free Software Foundation, Inc. Contributed by Francois-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Fallback FPU-related code (for systems not otherwise supported). ! Copyright 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Francois-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ /* Fallback FPU-related code for systems not otherwise supported. This --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ /* Fallback FPU-related code for systems not otherwise supported. This diff -Nrcpad gcc-4.3.3/libgfortran/config/fpu-glibc.h gcc-4.4.0/libgfortran/config/fpu-glibc.h *** gcc-4.3.3/libgfortran/config/fpu-glibc.h Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/config/fpu-glibc.h Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* FPU-related code for systems with GNU libc. ! Copyright 2005, 2007 Free Software Foundation, Inc. Contributed by Francois-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* FPU-related code for systems with GNU libc. ! Copyright 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Francois-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,33 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ /* FPU-related code for systems with the GNU libc, providing the feenableexcept function in fenv.h to set individual exceptions --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ /* FPU-related code for systems with the GNU libc, providing the feenableexcept function in fenv.h to set individual exceptions diff -Nrcpad gcc-4.3.3/libgfortran/config/fpu-sysv.h gcc-4.4.0/libgfortran/config/fpu-sysv.h *** gcc-4.3.3/libgfortran/config/fpu-sysv.h Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/config/fpu-sysv.h Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* SysV FPU-related code (for systems not otherwise supported). ! Copyright 2005, 2007 Free Software Foundation, Inc. Contributed by Francois-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* SysV FPU-related code (for systems not otherwise supported). ! Copyright 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Francois-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,33 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ /* FPU-related code for SysV platforms with fpsetmask(). */ --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ /* FPU-related code for SysV platforms with fpsetmask(). */ diff -Nrcpad gcc-4.3.3/libgfortran/config.h.in gcc-4.4.0/libgfortran/config.h.in *** gcc-4.3.3/libgfortran/config.h.in Wed Dec 31 15:42:12 2008 --- gcc-4.4.0/libgfortran/config.h.in Mon Dec 29 20:10:00 2008 *************** *** 747,752 **** --- 747,755 ---- /* Define to 1 if you have the `ttyname' function. */ #undef HAVE_TTYNAME + /* Define to 1 if the system has the type `uintptr_t'. */ + #undef HAVE_UINTPTR_T + /* Define to 1 if you have the header file. */ #undef HAVE_UNISTD_H diff -Nrcpad gcc-4.3.3/libgfortran/configure gcc-4.4.0/libgfortran/configure *** gcc-4.3.3/libgfortran/configure Sat Jan 24 10:32:29 2009 --- gcc-4.4.0/libgfortran/configure Tue Apr 21 09:08:08 2009 *************** ac_includes_default="\ *** 457,464 **** # include #endif" ! ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os build_libsubdir build_subdir host_subdir target_subdir onestep_TRUE onestep_FALSE onestep host host_cpu host_vendor host_os target target_cpu target_vendor target_os INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA CYGPATH_W PACKAGE VERSION ACLOCAL AUTOCONF AUTOMAKE AUTOHEADER MAKEINFO install_sh STRIP ac_ct_STRIP INSTALL_STRIP_PROGRAM mkdir_p AWK SET_MAKE am__leading_dot AMTAR am__tar am__untar MAINTAINER_MODE_TRUE MAINTAINER_MODE_FALSE MAINT multi_basedir toolexecdir toolexeclibdir CC ac_ct_CC EXEEXT OBJEXT DEPDIR am__include am__quote AMDEP_TRUE AMDEP_FALSE AMDEPBACKSLASH CCDEPMODE am__fastdepCC_TRUE am__fastdepCC_FALSE AM_FCFLAGS AM_CFLAGS CFLAGS LIBGFOR_USE_SYMVER_TRUE LIBGFOR_USE_SYMVER_FALSE AS ac_ct_AS AR ac_ct_AR RANLIB ac_ct_RANLIB LIBTOOL SED EGREP FGREP GREP LD DUMPBIN ac_ct_DUMPBIN NM LN_S lt_ECHO CPP CPPFLAGS enable_shared enable_static FC FCFLAGS LDFLAGS ac_ct_FC extra_ldflags_libgfortran FPU_HOST_HEADER LIBOBJS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. ac_init_help= --- 457,465 ---- # include #endif" ! ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os build_libsubdir build_subdir host_subdir target_subdir onestep_TRUE onestep_FALSE onestep host host_cpu host_vendor host_os target target_cpu target_vendor target_os INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA CYGPATH_W PACKAGE VERSION ACLOCAL AUTOCONF AUTOMAKE AUTOHEADER MAKEINFO install_sh STRIP ac_ct_STRIP INSTALL_STRIP_PROGRAM mkdir_p AWK SET_MAKE am__leading_dot AMTAR am__tar am__untar MAINTAINER_MODE_TRUE MAINTAINER_MODE_FALSE MAINT multi_basedir toolexecdir toolexeclibdir CC ac_ct_CC EXEEXT OBJEXT DEPDIR am__include am__quote AMDEP_TRUE AMDEP_FALSE AMDEPBACKSLASH CCDEPMODE am__fastdepCC_TRUE am__fastdepCC_FALSE AM_FCFLAGS AM_CFLAGS CFLAGS LIBGFOR_USE_SYMVER_TRUE LIBGFOR_USE_SYMVER_FALSE AS ac_ct_AS AR ac_ct_AR RANLIB ac_ct_RANLIB LIBTOOL SED EGREP FGREP GREP LD DUMPBIN ac_ct_DUMPBIN NM LN_S OBJDUMP ac_ct_OBJDUMP lt_ECHO DSYMUTIL ac_ct_DSYMUTIL NMEDIT ac_ct_NMEDIT LIPO ac_ct_LIPO OTOOL ac_ct_OTOOL OTOOL64 ac_ct_OTOOL64 CPP CPPFLAGS enable_shared enable_static FC FCFLAGS LDFLAGS ac_ct_FC extra_ldflags_libgfortran FPU_HOST_HEADER LIBOBJS LTLIBOBJS' ac_subst_files='' + ac_pwd=`pwd` # Initialize some variables set by options. ac_init_help= *************** echo "$as_me: error: \`$ac_var' was not *** 1421,1433 **** ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then ! { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} ! { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 ! echo "$as_me: former value: $ac_old_val" >&2;} ! { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 ! echo "$as_me: current value: $ac_new_val" >&2;} ! ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. --- 1422,1443 ---- ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then ! # differences in whitespace do not lead to failure. ! ac_old_val_w=`echo x $ac_old_val` ! ac_new_val_w=`echo x $ac_new_val` ! if test "$ac_old_val_w" != "$ac_new_val_w"; then ! { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} ! ac_cache_corrupted=: ! else ! { echo "$as_me:$LINENO: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 ! echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} ! eval $ac_var=\$ac_old_val ! fi ! { echo "$as_me:$LINENO: former value: \`$ac_old_val'" >&5 ! echo "$as_me: former value: \`$ac_old_val'" >&2;} ! { echo "$as_me:$LINENO: current value: \`$ac_new_val'" >&5 ! echo "$as_me: current value: \`$ac_new_val'" >&2;} fi;; esac # Pass precious variables to config.status. *************** echo "$as_me: current value: $ac_new_v *** 1444,1449 **** --- 1454,1461 ---- fi done if $ac_cache_corrupted; then + { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 + echo "$as_me: error: in \`$ac_pwd':" >&2;} { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 *************** ac_compiler_gnu=$ac_cv_c_compiler_gnu *** 1483,1488 **** --- 1495,1503 ---- + + + ac_config_headers="$ac_config_headers config.h" ac_aux_dir= *************** am__api_version="1.9" *** 1728,1733 **** --- 1743,1749 ---- # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # OS/2's system install, which has a completely different semantic # ./install, which can be erroneously created by make from ./install.sh. + # Reject install programs that cannot install multiple files. echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5 echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6 if test -z "$INSTALL"; then *************** case $as_dir/ in *** 1761,1768 **** # program-specific install script used by HP pwplus--don't use. : else ! ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" ! break 3 fi fi done --- 1777,1794 ---- # program-specific install script used by HP pwplus--don't use. : else ! rm -rf conftest.one conftest.two conftest.dir ! echo one > conftest.one ! echo two > conftest.two ! mkdir conftest.dir ! if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" && ! test -s conftest.one && test -s conftest.two && ! test -s conftest.dir/conftest.one && ! test -s conftest.dir/conftest.two ! then ! ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" ! break 3 ! fi fi fi done *************** case $as_dir/ in *** 1771,1785 **** esac done fi if test "${ac_cv_path_install+set}" = set; then INSTALL=$ac_cv_path_install else ! # As a last resort, use the slow shell script. We don't cache a ! # path for INSTALL within a source directory, because that will # break other packages using the cache if that directory is ! # removed, or if the path is relative. INSTALL=$ac_install_sh fi fi --- 1797,1812 ---- esac done + rm -rf conftest.one conftest.two conftest.dir fi if test "${ac_cv_path_install+set}" = set; then INSTALL=$ac_cv_path_install else ! # As a last resort, use the slow shell script. Don't cache a ! # value for INSTALL within a source directory, because that will # break other packages using the cache if that directory is ! # removed, or if the value is a relative name. INSTALL=$ac_install_sh fi fi *************** fi *** 2542,2552 **** fi ! test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } # Provide some information about the compiler. echo "$as_me:$LINENO:" \ --- 2569,2581 ---- fi ! test -z "$CC" && { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 ! echo "$as_me: error: in \`$ac_pwd':" >&2;} ! { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } # Provide some information about the compiler. echo "$as_me:$LINENO:" \ *************** else *** 2665,2675 **** echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} ! { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext --- 2694,2706 ---- echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 + { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 + echo "$as_me: error: in \`$ac_pwd':" >&2;} { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} ! { (exit 77); exit 77; }; }; } fi ac_exeext=$ac_cv_exeext *************** if test "$cross_compiling" != yes; then *** 2694,2706 **** if test "$cross_compiling" = maybe; then cross_compiling=yes else ! { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } fi fi fi --- 2725,2739 ---- if test "$cross_compiling" = maybe; then cross_compiling=yes else ! { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 ! echo "$as_me: error: in \`$ac_pwd':" >&2;} ! { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } fi fi fi *************** for ac_file in conftest.exe conftest con *** 2738,2748 **** esac done else ! { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext --- 2771,2783 ---- esac done else ! { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 ! echo "$as_me: error: in \`$ac_pwd':" >&2;} ! { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } fi rm -f conftest$ac_cv_exeext *************** else *** 2790,2800 **** echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext --- 2825,2837 ---- echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 + { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 + echo "$as_me: error: in \`$ac_pwd':" >&2;} { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext *************** fi *** 3375,3381 **** # Add -Wall -fno-repack-arrays -fno-underscoring if we are using GCC. if test "x$GCC" = "xyes"; then ! AM_FCFLAGS="-I . -Wall -fno-repack-arrays -fno-underscoring" ## We like to use C99 routines when available. This makes sure that ## __STDC_VERSION__ is set such that libc includes make them available. AM_CFLAGS="-std=gnu99 -Wall -Wstrict-prototypes -Wmissing-prototypes -Wold-style-definition -Wextra -Wwrite-strings" --- 3412,3418 ---- # Add -Wall -fno-repack-arrays -fno-underscoring if we are using GCC. if test "x$GCC" = "xyes"; then ! AM_FCFLAGS="-I . -Wall -Werror -fimplicit-none -fno-repack-arrays -fno-underscoring" ## We like to use C99 routines when available. This makes sure that ## __STDC_VERSION__ is set such that libc includes make them available. AM_CFLAGS="-std=gnu99 -Wall -Wstrict-prototypes -Wmissing-prototypes -Wold-style-definition -Wextra -Wwrite-strings" *************** fi *** 3744,3749 **** --- 3781,3787 ---- # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # OS/2's system install, which has a completely different semantic # ./install, which can be erroneously created by make from ./install.sh. + # Reject install programs that cannot install multiple files. echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5 echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6 if test -z "$INSTALL"; then *************** case $as_dir/ in *** 3777,3784 **** # program-specific install script used by HP pwplus--don't use. : else ! ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" ! break 3 fi fi done --- 3815,3832 ---- # program-specific install script used by HP pwplus--don't use. : else ! rm -rf conftest.one conftest.two conftest.dir ! echo one > conftest.one ! echo two > conftest.two ! mkdir conftest.dir ! if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" && ! test -s conftest.one && test -s conftest.two && ! test -s conftest.dir/conftest.one && ! test -s conftest.dir/conftest.two ! then ! ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" ! break 3 ! fi fi fi done *************** case $as_dir/ in *** 3787,3801 **** esac done fi if test "${ac_cv_path_install+set}" = set; then INSTALL=$ac_cv_path_install else ! # As a last resort, use the slow shell script. We don't cache a ! # path for INSTALL within a source directory, because that will # break other packages using the cache if that directory is ! # removed, or if the path is relative. INSTALL=$ac_install_sh fi fi --- 3835,3850 ---- esac done + rm -rf conftest.one conftest.two conftest.dir fi if test "${ac_cv_path_install+set}" = set; then INSTALL=$ac_cv_path_install else ! # As a last resort, use the slow shell script. Don't cache a ! # value for INSTALL within a source directory, because that will # break other packages using the cache if that directory is ! # removed, or if the value is a relative name. INSTALL=$ac_install_sh fi fi *************** enable_dlopen=yes *** 3817,3948 **** - macro_version='2.1a' - macro_revision='1.2435' - - - - - - - - - - - - - ltmain="$ac_aux_dir/ltmain.sh" - - # Set options - - - enable_win32_dll=no - - - # Check whether --enable-shared or --disable-shared was given. - if test "${enable_shared+set}" = set; then - enableval="$enable_shared" - p=${PACKAGE-default} - case $enableval in - yes) enable_shared=yes ;; - no) enable_shared=no ;; - *) - enable_shared=no - # Look at the argument we got. We use all the common list separators. - lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR," - for pkg in $enableval; do - IFS="$lt_save_ifs" - if test "X$pkg" = "X$p"; then - enable_shared=yes - fi - done - IFS="$lt_save_ifs" - ;; - esac - else - enable_shared=yes - fi; - - - - - - - - - # Check whether --enable-static or --disable-static was given. - if test "${enable_static+set}" = set; then - enableval="$enable_static" - p=${PACKAGE-default} - case $enableval in - yes) enable_static=yes ;; - no) enable_static=no ;; - *) - enable_static=no - # Look at the argument we got. We use all the common list separators. - lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR," - for pkg in $enableval; do - IFS="$lt_save_ifs" - if test "X$pkg" = "X$p"; then - enable_static=yes - fi - done - IFS="$lt_save_ifs" - ;; - esac - else - enable_static=yes - fi; - - - - - - - - - - # Check whether --with-pic or --without-pic was given. - if test "${with_pic+set}" = set; then - withval="$with_pic" - pic_mode="$withval" - else - pic_mode=default - fi; - - test -z "$pic_mode" && pic_mode=default - # Check whether --enable-fast-install or --disable-fast-install was given. - if test "${enable_fast_install+set}" = set; then - enableval="$enable_fast_install" - p=${PACKAGE-default} - case $enableval in - yes) enable_fast_install=yes ;; - no) enable_fast_install=no ;; - *) - enable_fast_install=no - # Look at the argument we got. We use all the common list separators. - lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR," - for pkg in $enableval; do - IFS="$lt_save_ifs" - if test "X$pkg" = "X$p"; then - enable_fast_install=yes - fi - done - IFS="$lt_save_ifs" - ;; - esac - else - enable_fast_install=yes - fi; --- 3866,3887 ---- + case `pwd` in + *\ * | *\ *) + { echo "$as_me:$LINENO: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&5 + echo "$as_me: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&2;} ;; + esac + macro_version='2.2.6' + macro_revision='1.3012' *************** fi; *** 3950,3955 **** --- 3889,3895 ---- + ltmain="$ac_aux_dir/ltmain.sh" echo "$as_me:$LINENO: checking for a sed that does not truncate output" >&5 echo $ECHO_N "checking for a sed that does not truncate output... $ECHO_C" >&6 *************** with_gnu_ld=$lt_cv_prog_gnu_ld *** 4186,4192 **** - echo "$as_me:$LINENO: checking for BSD- or MS-compatible name lister (nm)" >&5 echo $ECHO_N "checking for BSD- or MS-compatible name lister (nm)... $ECHO_C" >&6 if test "${lt_cv_path_NM+set}" = set; then --- 4126,4131 ---- *************** if test "${lt_cv_nm_interface+set}" = se *** 4348,4360 **** else lt_cv_nm_interface="BSD nm" echo "int some_variable = 0;" > conftest.$ac_ext ! (eval echo "\"\$as_me:4351: $ac_compile\"" >&5) (eval "$ac_compile" 2>conftest.err) cat conftest.err >&5 ! (eval echo "\"\$as_me:4354: $NM \\\"conftest.$ac_objext\\\"\"" >&5) (eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out) cat conftest.err >&5 ! (eval echo "\"\$as_me:4357: output\"" >&5) cat conftest.out >&5 if $GREP 'External.*some_variable' conftest.out > /dev/null; then lt_cv_nm_interface="MS dumpbin" --- 4287,4299 ---- else lt_cv_nm_interface="BSD nm" echo "int some_variable = 0;" > conftest.$ac_ext ! (eval echo "\"\$as_me:4290: $ac_compile\"" >&5) (eval "$ac_compile" 2>conftest.err) cat conftest.err >&5 ! (eval echo "\"\$as_me:4293: $NM \\\"conftest.$ac_objext\\\"\"" >&5) (eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out) cat conftest.err >&5 ! (eval echo "\"\$as_me:4296: output\"" >&5) cat conftest.out >&5 if $GREP 'External.*some_variable' conftest.out > /dev/null; then lt_cv_nm_interface="MS dumpbin" *************** else *** 4400,4406 **** lt_cv_sys_max_cmd_len=-1; ;; ! cygwin* | mingw*) # On Win9x/ME, this test blows up -- it succeeds, but takes # about 5 minutes as the teststring grows exponentially. # Worse, since 9x/ME are not pre-emptively multitasking, --- 4339,4345 ---- lt_cv_sys_max_cmd_len=-1; ;; ! cygwin* | mingw* | cegcc*) # On Win9x/ME, this test blows up -- it succeeds, but takes # about 5 minutes as the teststring grows exponentially. # Worse, since 9x/ME are not pre-emptively multitasking, *************** else *** 4461,4468 **** fi ;; *) ! lt_cv_sys_max_cmd_len=`getconf ARG_MAX 2> /dev/null` ! if test -n $lt_cv_sys_max_cmd_len; then lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4` lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3` else --- 4400,4407 ---- fi ;; *) ! lt_cv_sys_max_cmd_len=`(getconf ARG_MAX) 2> /dev/null` ! if test -n "$lt_cv_sys_max_cmd_len"; then lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4` lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3` else *************** max_cmd_len=$lt_cv_sys_max_cmd_len *** 4509,4515 **** - : ${CP="cp -f"} : ${MV="mv -f"} : ${RM="rm -f"} --- 4448,4453 ---- *************** echo $ECHO_N "checking whether the shell *** 4520,4526 **** xsi_shell=no ( _lt_dummy="a/b/c" test "${_lt_dummy##*/},${_lt_dummy%/*},"${_lt_dummy%"$_lt_dummy"}, \ ! = c,a/b,, ) >/dev/null 2>&1 \ && xsi_shell=yes echo "$as_me:$LINENO: result: $xsi_shell" >&5 echo "${ECHO_T}$xsi_shell" >&6 --- 4458,4466 ---- xsi_shell=no ( _lt_dummy="a/b/c" test "${_lt_dummy##*/},${_lt_dummy%/*},"${_lt_dummy%"$_lt_dummy"}, \ ! = c,a/b,, \ ! && eval 'test $(( 1 + 1 )) -eq 2 \ ! && test "${#_lt_dummy}" -eq 5' ) >/dev/null 2>&1 \ && xsi_shell=yes echo "$as_me:$LINENO: result: $xsi_shell" >&5 echo "${ECHO_T}$xsi_shell" >&6 *************** esac *** 4600,4605 **** --- 4540,4634 ---- + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}objdump", so it can be a program name with args. + set dummy ${ac_tool_prefix}objdump; ac_word=$2 + echo "$as_me:$LINENO: checking for $ac_word" >&5 + echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 + if test "${ac_cv_prog_OBJDUMP+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + if test -n "$OBJDUMP"; then + ac_cv_prog_OBJDUMP="$OBJDUMP" # Let the user override the test. + else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR + for as_dir in $PATH + do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_OBJDUMP="${ac_tool_prefix}objdump" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi + done + done + + fi + fi + OBJDUMP=$ac_cv_prog_OBJDUMP + if test -n "$OBJDUMP"; then + echo "$as_me:$LINENO: result: $OBJDUMP" >&5 + echo "${ECHO_T}$OBJDUMP" >&6 + else + echo "$as_me:$LINENO: result: no" >&5 + echo "${ECHO_T}no" >&6 + fi + + fi + if test -z "$ac_cv_prog_OBJDUMP"; then + ac_ct_OBJDUMP=$OBJDUMP + # Extract the first word of "objdump", so it can be a program name with args. + set dummy objdump; ac_word=$2 + echo "$as_me:$LINENO: checking for $ac_word" >&5 + echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 + if test "${ac_cv_prog_ac_ct_OBJDUMP+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + if test -n "$ac_ct_OBJDUMP"; then + ac_cv_prog_ac_ct_OBJDUMP="$ac_ct_OBJDUMP" # Let the user override the test. + else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR + for as_dir in $PATH + do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_OBJDUMP="objdump" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi + done + done + + test -z "$ac_cv_prog_ac_ct_OBJDUMP" && ac_cv_prog_ac_ct_OBJDUMP="false" + fi + fi + ac_ct_OBJDUMP=$ac_cv_prog_ac_ct_OBJDUMP + if test -n "$ac_ct_OBJDUMP"; then + echo "$as_me:$LINENO: result: $ac_ct_OBJDUMP" >&5 + echo "${ECHO_T}$ac_ct_OBJDUMP" >&6 + else + echo "$as_me:$LINENO: result: no" >&5 + echo "${ECHO_T}no" >&6 + fi + + OBJDUMP=$ac_ct_OBJDUMP + else + OBJDUMP="$ac_cv_prog_OBJDUMP" + fi + + test -z "$OBJDUMP" && OBJDUMP=objdump + + + + + + + + echo "$as_me:$LINENO: checking how to recognize dependent libraries" >&5 echo $ECHO_N "checking how to recognize dependent libraries... $ECHO_C" >&6 *************** mingw* | pw32*) *** 4654,4659 **** --- 4683,4694 ---- fi ;; + cegcc) + # use the weaker test based on 'objdump'. See mingw*. + lt_cv_deplibs_check_method='file_magic file format pe-arm-.*little(.*architecture: arm)?' + lt_cv_file_magic_cmd='$OBJDUMP -f' + ;; + darwin* | rhapsody*) lt_cv_deplibs_check_method=pass_all ;; *************** irix5* | irix6* | nonstopux*) *** 4712,4718 **** ;; # This must be Linux ELF. ! linux* | k*bsd*-gnu) lt_cv_deplibs_check_method=pass_all ;; --- 4747,4753 ---- ;; # This must be Linux ELF. ! linux* | k*bsd*-gnu | kopensolaris*-gnu) lt_cv_deplibs_check_method=pass_all ;; *************** test -z "$RANLIB" && RANLIB=: *** 5076,5082 **** # Determine commands to create old-style static archives. ! old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs$old_deplibs' old_postinstall_cmds='chmod 644 $oldlib' old_postuninstall_cmds= --- 5111,5117 ---- # Determine commands to create old-style static archives. ! old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs' old_postinstall_cmds='chmod 644 $oldlib' old_postuninstall_cmds= *************** case $host_os in *** 5156,5162 **** aix*) symcode='[BCDT]' ;; ! cygwin* | mingw* | pw32*) symcode='[ABCDGISTW]' ;; hpux*) --- 5191,5197 ---- aix*) symcode='[BCDT]' ;; ! cygwin* | mingw* | pw32* | cegcc*) symcode='[ABCDGISTW]' ;; hpux*) *************** lt_cv_sys_global_symbol_to_cdecl="sed -n *** 5200,5205 **** --- 5235,5241 ---- # Transform an extracted symbol line into symbol name and symbol address lt_cv_sys_global_symbol_to_c_name_address="sed -n -e 's/^: \([^ ]*\) $/ {\\\"\1\\\", (void *) 0},/p' -e 's/^$symcode* \([^ ]*\) \([^ ]*\)$/ {\"\2\", (void *) \&\2},/p'" + lt_cv_sys_global_symbol_to_c_name_address_lib_prefix="sed -n -e 's/^: \([^ ]*\) $/ {\\\"\1\\\", (void *) 0},/p' -e 's/^$symcode* \([^ ]*\) \(lib[^ ]*\)$/ {\"\2\", (void *) \&\2},/p' -e 's/^$symcode* \([^ ]*\) \([^ ]*\)$/ {\"lib\2\", (void *) \&\2},/p'" # Handle CRLF in mingw tool chain opt_cr= *************** _LT_EOF *** 5339,5345 **** echo "$progname: failed program was:" >&5 cat conftest.$ac_ext >&5 fi ! rm -f conftest* conftst* # Do not use the global_symbol_pipe unless it works. if test "$pipe_works" = yes; then --- 5375,5381 ---- echo "$progname: failed program was:" >&5 cat conftest.$ac_ext >&5 fi ! rm -rf conftest* conftst* # Do not use the global_symbol_pipe unless it works. if test "$pipe_works" = yes; then *************** fi *** 5378,5383 **** --- 5414,5424 ---- + + + + + # Check whether --enable-libtool-lock or --disable-libtool-lock was given. if test "${enable_libtool_lock+set}" = set; then enableval="$enable_libtool_lock" *************** ia64-*-hpux*) *** 5409,5415 **** ;; *-*-irix6*) # Find out which ABI we are using. ! echo '#line 5412 "configure"' > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? --- 5450,5456 ---- ;; *-*-irix6*) # Find out which ABI we are using. ! echo '#line 5453 "configure"' > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? *************** sparc*-*solaris*) *** 5589,5595 **** *64-bit*) case $lt_cv_prog_gnu_ld in yes*) LD="${LD-ld} -m elf64_sparc" ;; ! *) LD="${LD-ld} -64" ;; esac ;; esac --- 5630,5640 ---- *64-bit*) case $lt_cv_prog_gnu_ld in yes*) LD="${LD-ld} -m elf64_sparc" ;; ! *) ! if ${LD-ld} -64 -r -o conftest2.o conftest.o >/dev/null 2>&1; then ! LD="${LD-ld} -64" ! fi ! ;; esac ;; esac *************** esac *** 5600,5605 **** --- 5645,6208 ---- need_locks="$enable_libtool_lock" + + case $host_os in + rhapsody* | darwin*) + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}dsymutil", so it can be a program name with args. + set dummy ${ac_tool_prefix}dsymutil; ac_word=$2 + echo "$as_me:$LINENO: checking for $ac_word" >&5 + echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 + if test "${ac_cv_prog_DSYMUTIL+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + if test -n "$DSYMUTIL"; then + ac_cv_prog_DSYMUTIL="$DSYMUTIL" # Let the user override the test. + else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR + for as_dir in $PATH + do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_DSYMUTIL="${ac_tool_prefix}dsymutil" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi + done + done + + fi + fi + DSYMUTIL=$ac_cv_prog_DSYMUTIL + if test -n "$DSYMUTIL"; then + echo "$as_me:$LINENO: result: $DSYMUTIL" >&5 + echo "${ECHO_T}$DSYMUTIL" >&6 + else + echo "$as_me:$LINENO: result: no" >&5 + echo "${ECHO_T}no" >&6 + fi + + fi + if test -z "$ac_cv_prog_DSYMUTIL"; then + ac_ct_DSYMUTIL=$DSYMUTIL + # Extract the first word of "dsymutil", so it can be a program name with args. + set dummy dsymutil; ac_word=$2 + echo "$as_me:$LINENO: checking for $ac_word" >&5 + echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 + if test "${ac_cv_prog_ac_ct_DSYMUTIL+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + if test -n "$ac_ct_DSYMUTIL"; then + ac_cv_prog_ac_ct_DSYMUTIL="$ac_ct_DSYMUTIL" # Let the user override the test. + else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR + for as_dir in $PATH + do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_DSYMUTIL="dsymutil" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi + done + done + + test -z "$ac_cv_prog_ac_ct_DSYMUTIL" && ac_cv_prog_ac_ct_DSYMUTIL=":" + fi + fi + ac_ct_DSYMUTIL=$ac_cv_prog_ac_ct_DSYMUTIL + if test -n "$ac_ct_DSYMUTIL"; then + echo "$as_me:$LINENO: result: $ac_ct_DSYMUTIL" >&5 + echo "${ECHO_T}$ac_ct_DSYMUTIL" >&6 + else + echo "$as_me:$LINENO: result: no" >&5 + echo "${ECHO_T}no" >&6 + fi + + DSYMUTIL=$ac_ct_DSYMUTIL + else + DSYMUTIL="$ac_cv_prog_DSYMUTIL" + fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}nmedit", so it can be a program name with args. + set dummy ${ac_tool_prefix}nmedit; ac_word=$2 + echo "$as_me:$LINENO: checking for $ac_word" >&5 + echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 + if test "${ac_cv_prog_NMEDIT+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + if test -n "$NMEDIT"; then + ac_cv_prog_NMEDIT="$NMEDIT" # Let the user override the test. + else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR + for as_dir in $PATH + do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_NMEDIT="${ac_tool_prefix}nmedit" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi + done + done + + fi + fi + NMEDIT=$ac_cv_prog_NMEDIT + if test -n "$NMEDIT"; then + echo "$as_me:$LINENO: result: $NMEDIT" >&5 + echo "${ECHO_T}$NMEDIT" >&6 + else + echo "$as_me:$LINENO: result: no" >&5 + echo "${ECHO_T}no" >&6 + fi + + fi + if test -z "$ac_cv_prog_NMEDIT"; then + ac_ct_NMEDIT=$NMEDIT + # Extract the first word of "nmedit", so it can be a program name with args. + set dummy nmedit; ac_word=$2 + echo "$as_me:$LINENO: checking for $ac_word" >&5 + echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 + if test "${ac_cv_prog_ac_ct_NMEDIT+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + if test -n "$ac_ct_NMEDIT"; then + ac_cv_prog_ac_ct_NMEDIT="$ac_ct_NMEDIT" # Let the user override the test. + else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR + for as_dir in $PATH + do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_NMEDIT="nmedit" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi + done + done + + test -z "$ac_cv_prog_ac_ct_NMEDIT" && ac_cv_prog_ac_ct_NMEDIT=":" + fi + fi + ac_ct_NMEDIT=$ac_cv_prog_ac_ct_NMEDIT + if test -n "$ac_ct_NMEDIT"; then + echo "$as_me:$LINENO: result: $ac_ct_NMEDIT" >&5 + echo "${ECHO_T}$ac_ct_NMEDIT" >&6 + else + echo "$as_me:$LINENO: result: no" >&5 + echo "${ECHO_T}no" >&6 + fi + + NMEDIT=$ac_ct_NMEDIT + else + NMEDIT="$ac_cv_prog_NMEDIT" + fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}lipo", so it can be a program name with args. + set dummy ${ac_tool_prefix}lipo; ac_word=$2 + echo "$as_me:$LINENO: checking for $ac_word" >&5 + echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 + if test "${ac_cv_prog_LIPO+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + if test -n "$LIPO"; then + ac_cv_prog_LIPO="$LIPO" # Let the user override the test. + else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR + for as_dir in $PATH + do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_LIPO="${ac_tool_prefix}lipo" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi + done + done + + fi + fi + LIPO=$ac_cv_prog_LIPO + if test -n "$LIPO"; then + echo "$as_me:$LINENO: result: $LIPO" >&5 + echo "${ECHO_T}$LIPO" >&6 + else + echo "$as_me:$LINENO: result: no" >&5 + echo "${ECHO_T}no" >&6 + fi + + fi + if test -z "$ac_cv_prog_LIPO"; then + ac_ct_LIPO=$LIPO + # Extract the first word of "lipo", so it can be a program name with args. + set dummy lipo; ac_word=$2 + echo "$as_me:$LINENO: checking for $ac_word" >&5 + echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 + if test "${ac_cv_prog_ac_ct_LIPO+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + if test -n "$ac_ct_LIPO"; then + ac_cv_prog_ac_ct_LIPO="$ac_ct_LIPO" # Let the user override the test. + else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR + for as_dir in $PATH + do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_LIPO="lipo" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi + done + done + + test -z "$ac_cv_prog_ac_ct_LIPO" && ac_cv_prog_ac_ct_LIPO=":" + fi + fi + ac_ct_LIPO=$ac_cv_prog_ac_ct_LIPO + if test -n "$ac_ct_LIPO"; then + echo "$as_me:$LINENO: result: $ac_ct_LIPO" >&5 + echo "${ECHO_T}$ac_ct_LIPO" >&6 + else + echo "$as_me:$LINENO: result: no" >&5 + echo "${ECHO_T}no" >&6 + fi + + LIPO=$ac_ct_LIPO + else + LIPO="$ac_cv_prog_LIPO" + fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}otool", so it can be a program name with args. + set dummy ${ac_tool_prefix}otool; ac_word=$2 + echo "$as_me:$LINENO: checking for $ac_word" >&5 + echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 + if test "${ac_cv_prog_OTOOL+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + if test -n "$OTOOL"; then + ac_cv_prog_OTOOL="$OTOOL" # Let the user override the test. + else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR + for as_dir in $PATH + do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_OTOOL="${ac_tool_prefix}otool" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi + done + done + + fi + fi + OTOOL=$ac_cv_prog_OTOOL + if test -n "$OTOOL"; then + echo "$as_me:$LINENO: result: $OTOOL" >&5 + echo "${ECHO_T}$OTOOL" >&6 + else + echo "$as_me:$LINENO: result: no" >&5 + echo "${ECHO_T}no" >&6 + fi + + fi + if test -z "$ac_cv_prog_OTOOL"; then + ac_ct_OTOOL=$OTOOL + # Extract the first word of "otool", so it can be a program name with args. + set dummy otool; ac_word=$2 + echo "$as_me:$LINENO: checking for $ac_word" >&5 + echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 + if test "${ac_cv_prog_ac_ct_OTOOL+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + if test -n "$ac_ct_OTOOL"; then + ac_cv_prog_ac_ct_OTOOL="$ac_ct_OTOOL" # Let the user override the test. + else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR + for as_dir in $PATH + do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_OTOOL="otool" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi + done + done + + test -z "$ac_cv_prog_ac_ct_OTOOL" && ac_cv_prog_ac_ct_OTOOL=":" + fi + fi + ac_ct_OTOOL=$ac_cv_prog_ac_ct_OTOOL + if test -n "$ac_ct_OTOOL"; then + echo "$as_me:$LINENO: result: $ac_ct_OTOOL" >&5 + echo "${ECHO_T}$ac_ct_OTOOL" >&6 + else + echo "$as_me:$LINENO: result: no" >&5 + echo "${ECHO_T}no" >&6 + fi + + OTOOL=$ac_ct_OTOOL + else + OTOOL="$ac_cv_prog_OTOOL" + fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}otool64", so it can be a program name with args. + set dummy ${ac_tool_prefix}otool64; ac_word=$2 + echo "$as_me:$LINENO: checking for $ac_word" >&5 + echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 + if test "${ac_cv_prog_OTOOL64+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + if test -n "$OTOOL64"; then + ac_cv_prog_OTOOL64="$OTOOL64" # Let the user override the test. + else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR + for as_dir in $PATH + do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_OTOOL64="${ac_tool_prefix}otool64" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi + done + done + + fi + fi + OTOOL64=$ac_cv_prog_OTOOL64 + if test -n "$OTOOL64"; then + echo "$as_me:$LINENO: result: $OTOOL64" >&5 + echo "${ECHO_T}$OTOOL64" >&6 + else + echo "$as_me:$LINENO: result: no" >&5 + echo "${ECHO_T}no" >&6 + fi + + fi + if test -z "$ac_cv_prog_OTOOL64"; then + ac_ct_OTOOL64=$OTOOL64 + # Extract the first word of "otool64", so it can be a program name with args. + set dummy otool64; ac_word=$2 + echo "$as_me:$LINENO: checking for $ac_word" >&5 + echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 + if test "${ac_cv_prog_ac_ct_OTOOL64+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + if test -n "$ac_ct_OTOOL64"; then + ac_cv_prog_ac_ct_OTOOL64="$ac_ct_OTOOL64" # Let the user override the test. + else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR + for as_dir in $PATH + do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_OTOOL64="otool64" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi + done + done + + test -z "$ac_cv_prog_ac_ct_OTOOL64" && ac_cv_prog_ac_ct_OTOOL64=":" + fi + fi + ac_ct_OTOOL64=$ac_cv_prog_ac_ct_OTOOL64 + if test -n "$ac_ct_OTOOL64"; then + echo "$as_me:$LINENO: result: $ac_ct_OTOOL64" >&5 + echo "${ECHO_T}$ac_ct_OTOOL64" >&6 + else + echo "$as_me:$LINENO: result: no" >&5 + echo "${ECHO_T}no" >&6 + fi + + OTOOL64=$ac_ct_OTOOL64 + else + OTOOL64="$ac_cv_prog_OTOOL64" + fi + + + + + + + + + + + + + + + + + + + + + + + + + + + + echo "$as_me:$LINENO: checking for -single_module linker flag" >&5 + echo $ECHO_N "checking for -single_module linker flag... $ECHO_C" >&6 + if test "${lt_cv_apple_cc_single_mod+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + lt_cv_apple_cc_single_mod=no + if test -z "${LT_MULTI_MODULE}"; then + # By default we will add the -single_module flag. You can override + # by either setting the environment variable LT_MULTI_MODULE + # non-empty at configure time, or by adding -multi_module to the + # link flags. + rm -rf libconftest.dylib* + echo "int foo(void){return 1;}" > conftest.c + echo "$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \ + -dynamiclib -Wl,-single_module conftest.c" >&5 + $LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \ + -dynamiclib -Wl,-single_module conftest.c 2>conftest.err + _lt_result=$? + if test -f libconftest.dylib && test ! -s conftest.err && test $_lt_result = 0; then + lt_cv_apple_cc_single_mod=yes + else + cat conftest.err >&5 + fi + rm -rf libconftest.dylib* + rm -f conftest.* + fi + fi + echo "$as_me:$LINENO: result: $lt_cv_apple_cc_single_mod" >&5 + echo "${ECHO_T}$lt_cv_apple_cc_single_mod" >&6 + echo "$as_me:$LINENO: checking for -exported_symbols_list linker flag" >&5 + echo $ECHO_N "checking for -exported_symbols_list linker flag... $ECHO_C" >&6 + if test "${lt_cv_ld_exported_symbols_list+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + lt_cv_ld_exported_symbols_list=no + save_LDFLAGS=$LDFLAGS + echo "_main" > conftest.sym + LDFLAGS="$LDFLAGS -Wl,-exported_symbols_list,conftest.sym" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + int + main () + { + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + lt_cv_ld_exported_symbols_list=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + lt_cv_ld_exported_symbols_list=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS="$save_LDFLAGS" + + fi + echo "$as_me:$LINENO: result: $lt_cv_ld_exported_symbols_list" >&5 + echo "${ECHO_T}$lt_cv_ld_exported_symbols_list" >&6 + case $host_os in + rhapsody* | darwin1.[012]) + _lt_dar_allow_undefined='${wl}-undefined ${wl}suppress' ;; + darwin1.*) + _lt_dar_allow_undefined='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' ;; + darwin*) # darwin 5.x on + # if running on 10.5 or later, the deployment target defaults + # to the OS version, if on x86, and 10.4, the deployment + # target defaults to 10.4. Don't you love it? + case ${MACOSX_DEPLOYMENT_TARGET-10.0},$host in + 10.0,*86*-darwin8*|10.0,*-darwin[91]*) + _lt_dar_allow_undefined='${wl}-undefined ${wl}dynamic_lookup' ;; + 10.[012]*) + _lt_dar_allow_undefined='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' ;; + 10.*) + _lt_dar_allow_undefined='${wl}-undefined ${wl}dynamic_lookup' ;; + esac + ;; + esac + if test "$lt_cv_apple_cc_single_mod" = "yes"; then + _lt_dar_single_mod='$single_module' + fi + if test "$lt_cv_ld_exported_symbols_list" = "yes"; then + _lt_dar_export_syms=' ${wl}-exported_symbols_list,$output_objdir/${libname}-symbols.expsym' + else + _lt_dar_export_syms='~$NMEDIT -s $output_objdir/${libname}-symbols.expsym ${lib}' + fi + if test "$DSYMUTIL" != ":"; then + _lt_dsymutil='~$DSYMUTIL $lib || :' + else + _lt_dsymutil= + fi + ;; + esac + ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' *************** rm -f conftest.err conftest.$ac_ext *** 5821,5831 **** if $ac_preproc_ok; then : else ! { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } fi ac_ext=c --- 6424,6436 ---- if $ac_preproc_ok; then : else ! { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 ! echo "$as_me: error: in \`$ac_pwd':" >&2;} ! { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } fi ac_ext=c *************** done *** 6136,6141 **** --- 6741,6866 ---- + # Set options + + + + + enable_win32_dll=no + + + # Check whether --enable-shared or --disable-shared was given. + if test "${enable_shared+set}" = set; then + enableval="$enable_shared" + p=${PACKAGE-default} + case $enableval in + yes) enable_shared=yes ;; + no) enable_shared=no ;; + *) + enable_shared=no + # Look at the argument we got. We use all the common list separators. + lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR," + for pkg in $enableval; do + IFS="$lt_save_ifs" + if test "X$pkg" = "X$p"; then + enable_shared=yes + fi + done + IFS="$lt_save_ifs" + ;; + esac + else + enable_shared=yes + fi; + + + + + + + + + # Check whether --enable-static or --disable-static was given. + if test "${enable_static+set}" = set; then + enableval="$enable_static" + p=${PACKAGE-default} + case $enableval in + yes) enable_static=yes ;; + no) enable_static=no ;; + *) + enable_static=no + # Look at the argument we got. We use all the common list separators. + lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR," + for pkg in $enableval; do + IFS="$lt_save_ifs" + if test "X$pkg" = "X$p"; then + enable_static=yes + fi + done + IFS="$lt_save_ifs" + ;; + esac + else + enable_static=yes + fi; + + + + + + + + + + # Check whether --with-pic or --without-pic was given. + if test "${with_pic+set}" = set; then + withval="$with_pic" + pic_mode="$withval" + else + pic_mode=default + fi; + + test -z "$pic_mode" && pic_mode=default + + + + + + + + # Check whether --enable-fast-install or --disable-fast-install was given. + if test "${enable_fast_install+set}" = set; then + enableval="$enable_fast_install" + p=${PACKAGE-default} + case $enableval in + yes) enable_fast_install=yes ;; + no) enable_fast_install=no ;; + *) + enable_fast_install=no + # Look at the argument we got. We use all the common list separators. + lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR," + for pkg in $enableval; do + IFS="$lt_save_ifs" + if test "X$pkg" = "X$p"; then + enable_fast_install=yes + fi + done + IFS="$lt_save_ifs" + ;; + esac + else + enable_fast_install=yes + fi; + + + + + + + + + + # This can be used to rebuild libtool when needed LIBTOOL_DEPS="$ltmain" *************** ac_outfile=conftest.$ac_objext *** 6482,6488 **** echo "$lt_simple_link_test_code" >conftest.$ac_ext eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err _lt_linker_boilerplate=`cat conftest.err` ! $RM conftest* ## CAVEAT EMPTOR: --- 7207,7213 ---- echo "$lt_simple_link_test_code" >conftest.$ac_ext eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err _lt_linker_boilerplate=`cat conftest.err` ! $RM -r conftest* ## CAVEAT EMPTOR: *************** else *** 6514,6524 **** -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` ! (eval echo "\"\$as_me:6517: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 ! echo "$as_me:6521: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings other than the usual output. --- 7239,7249 ---- -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` ! (eval echo "\"\$as_me:7242: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 ! echo "$as_me:7246: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings other than the usual output. *************** echo $ECHO_N "checking for $compiler opt *** 6568,6586 **** ;; amigaos*) ! if test "$host_cpu" = m68k; then ! # FIXME: we need at least 68020 code to build shared libraries, but ! # adding the `-m68020' flag to GCC prevents building anything better, ! # like `-m68040'. ! lt_prog_compiler_pic='-m68020 -resident32 -malways-restore-a4' ! fi ;; beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) # PIC is the default for these OSes. ;; ! mingw* | cygwin* | pw32* | os2*) # This hack is so that the source file can tell whether it is being # built for inclusion in a dll (and should export symbols for example). # Although the cygwin gcc ignores -fPIC, still need this for old-style --- 7293,7317 ---- ;; amigaos*) ! case $host_cpu in ! powerpc) ! # see comment about AmigaOS4 .so support ! lt_prog_compiler_pic='-fPIC' ! ;; ! m68k) ! # FIXME: we need at least 68020 code to build shared libraries, but ! # adding the `-m68020' flag to GCC prevents building anything better, ! # like `-m68040'. ! lt_prog_compiler_pic='-m68020 -resident32 -malways-restore-a4' ! ;; ! esac ;; beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) # PIC is the default for these OSes. ;; ! mingw* | cygwin* | pw32* | os2* | cegcc*) # This hack is so that the source file can tell whether it is being # built for inclusion in a dll (and should export symbols for example). # Although the cygwin gcc ignores -fPIC, still need this for old-style *************** echo $ECHO_N "checking for $compiler opt *** 6595,6604 **** ;; hpux*) ! # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but ! # not for PA HP-UX. case $host_cpu in ! hppa*64*|ia64*) # +Z the default ;; *) --- 7326,7336 ---- ;; hpux*) ! # PIC is the default for 64-bit PA HP-UX, but not for 32-bit ! # PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag ! # sets the default TLS model and affects inlining. case $host_cpu in ! hppa*64*) # +Z the default ;; *) *************** echo $ECHO_N "checking for $compiler opt *** 6647,6664 **** lt_prog_compiler_static='-bnso -bI:/lib/syscalls.exp' fi ;; - darwin*) - # PIC is the default on this platform - # Common symbols not allowed in MH_DYLIB files - case $cc_basename in - xlc*) - lt_prog_compiler_pic='-qnocommon' - lt_prog_compiler_wl='-Wl,' - ;; - esac - ;; ! mingw* | cygwin* | pw32* | os2*) # This hack is so that the source file can tell whether it is being # built for inclusion in a dll (and should export symbols for example). lt_prog_compiler_pic='-DDLL_EXPORT' --- 7379,7386 ---- lt_prog_compiler_static='-bnso -bI:/lib/syscalls.exp' fi ;; ! mingw* | cygwin* | pw32* | os2* | cegcc*) # This hack is so that the source file can tell whether it is being # built for inclusion in a dll (and should export symbols for example). lt_prog_compiler_pic='-DDLL_EXPORT' *************** echo $ECHO_N "checking for $compiler opt *** 6686,6698 **** lt_prog_compiler_static='-non_shared' ;; ! linux* | k*bsd*-gnu) case $cc_basename in ! icc* | ecc*) lt_prog_compiler_wl='-Wl,' lt_prog_compiler_pic='-KPIC' lt_prog_compiler_static='-static' ;; pgcc* | pgf77* | pgf90* | pgf95*) # Portland Group compilers (*not* the Pentium gcc compiler, # which looks to be a dead project) --- 7408,7434 ---- lt_prog_compiler_static='-non_shared' ;; ! linux* | k*bsd*-gnu | kopensolaris*-gnu) case $cc_basename in ! # old Intel for x86_64 which still supported -KPIC. ! ecc*) lt_prog_compiler_wl='-Wl,' lt_prog_compiler_pic='-KPIC' lt_prog_compiler_static='-static' ;; + # icc used to be incompatible with GCC. + # ICC 10 doesn't accept -KPIC any more. + icc* | ifort*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-fPIC' + lt_prog_compiler_static='-static' + ;; + # Lahey Fortran 8.1. + lf95*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='--shared' + lt_prog_compiler_static='--static' + ;; pgcc* | pgf77* | pgf90* | pgf95*) # Portland Group compilers (*not* the Pentium gcc compiler, # which looks to be a dead project) *************** echo $ECHO_N "checking for $compiler opt *** 6705,6710 **** --- 7441,7452 ---- # All Alpha code is PIC. lt_prog_compiler_static='-non_shared' ;; + xl*) + # IBM XL C 8.0/Fortran 10.1 on PPC + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-qpic' + lt_prog_compiler_static='-qstaticlink' + ;; *) case `$CC -V 2>&1 | sed 5q` in *Sun\ C*) *************** echo "${ECHO_T}$lt_prog_compiler_pic" >& *** 6820,6829 **** if test -n "$lt_prog_compiler_pic"; then echo "$as_me:$LINENO: checking if $compiler PIC flag $lt_prog_compiler_pic works" >&5 echo $ECHO_N "checking if $compiler PIC flag $lt_prog_compiler_pic works... $ECHO_C" >&6 ! if test "${lt_prog_compiler_pic_works+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ! lt_prog_compiler_pic_works=no ac_outfile=conftest.$ac_objext echo "$lt_simple_compile_test_code" > conftest.$ac_ext lt_compiler_flag="$lt_prog_compiler_pic -DPIC" --- 7562,7571 ---- if test -n "$lt_prog_compiler_pic"; then echo "$as_me:$LINENO: checking if $compiler PIC flag $lt_prog_compiler_pic works" >&5 echo $ECHO_N "checking if $compiler PIC flag $lt_prog_compiler_pic works... $ECHO_C" >&6 ! if test "${lt_cv_prog_compiler_pic_works+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ! lt_cv_prog_compiler_pic_works=no ac_outfile=conftest.$ac_objext echo "$lt_simple_compile_test_code" > conftest.$ac_ext lt_compiler_flag="$lt_prog_compiler_pic -DPIC" *************** else *** 6836,6862 **** -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` ! (eval echo "\"\$as_me:6839: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 ! echo "$as_me:6843: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings other than the usual output. $ECHO "X$_lt_compiler_boilerplate" | $Xsed -e '/^$/d' >conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then ! lt_prog_compiler_pic_works=yes fi fi $RM conftest* fi ! echo "$as_me:$LINENO: result: $lt_prog_compiler_pic_works" >&5 ! echo "${ECHO_T}$lt_prog_compiler_pic_works" >&6 ! if test x"$lt_prog_compiler_pic_works" = xyes; then case $lt_prog_compiler_pic in "" | " "*) ;; *) lt_prog_compiler_pic=" $lt_prog_compiler_pic" ;; --- 7578,7604 ---- -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` ! (eval echo "\"\$as_me:7581: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 ! echo "$as_me:7585: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings other than the usual output. $ECHO "X$_lt_compiler_boilerplate" | $Xsed -e '/^$/d' >conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then ! lt_cv_prog_compiler_pic_works=yes fi fi $RM conftest* fi ! echo "$as_me:$LINENO: result: $lt_cv_prog_compiler_pic_works" >&5 ! echo "${ECHO_T}$lt_cv_prog_compiler_pic_works" >&6 ! if test x"$lt_cv_prog_compiler_pic_works" = xyes; then case $lt_prog_compiler_pic in "" | " "*) ;; *) lt_prog_compiler_pic=" $lt_prog_compiler_pic" ;; *************** fi *** 6879,6888 **** wl=$lt_prog_compiler_wl eval lt_tmp_static_flag=\"$lt_prog_compiler_static\" echo "$as_me:$LINENO: checking if $compiler static flag $lt_tmp_static_flag works" >&5 echo $ECHO_N "checking if $compiler static flag $lt_tmp_static_flag works... $ECHO_C" >&6 ! if test "${lt_prog_compiler_static_works+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ! lt_prog_compiler_static_works=no save_LDFLAGS="$LDFLAGS" LDFLAGS="$LDFLAGS $lt_tmp_static_flag" echo "$lt_simple_link_test_code" > conftest.$ac_ext --- 7621,7630 ---- wl=$lt_prog_compiler_wl eval lt_tmp_static_flag=\"$lt_prog_compiler_static\" echo "$as_me:$LINENO: checking if $compiler static flag $lt_tmp_static_flag works" >&5 echo $ECHO_N "checking if $compiler static flag $lt_tmp_static_flag works... $ECHO_C" >&6 ! if test "${lt_cv_prog_compiler_static_works+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ! lt_cv_prog_compiler_static_works=no save_LDFLAGS="$LDFLAGS" LDFLAGS="$LDFLAGS $lt_tmp_static_flag" echo "$lt_simple_link_test_code" > conftest.$ac_ext *************** else *** 6895,6914 **** $ECHO "X$_lt_linker_boilerplate" | $Xsed -e '/^$/d' > conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if diff conftest.exp conftest.er2 >/dev/null; then ! lt_prog_compiler_static_works=yes fi else ! lt_prog_compiler_static_works=yes fi fi ! $RM conftest* LDFLAGS="$save_LDFLAGS" fi ! echo "$as_me:$LINENO: result: $lt_prog_compiler_static_works" >&5 ! echo "${ECHO_T}$lt_prog_compiler_static_works" >&6 ! if test x"$lt_prog_compiler_static_works" = xyes; then : else lt_prog_compiler_static= --- 7637,7656 ---- $ECHO "X$_lt_linker_boilerplate" | $Xsed -e '/^$/d' > conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if diff conftest.exp conftest.er2 >/dev/null; then ! lt_cv_prog_compiler_static_works=yes fi else ! lt_cv_prog_compiler_static_works=yes fi fi ! $RM -r conftest* LDFLAGS="$save_LDFLAGS" fi ! echo "$as_me:$LINENO: result: $lt_cv_prog_compiler_static_works" >&5 ! echo "${ECHO_T}$lt_cv_prog_compiler_static_works" >&6 ! if test x"$lt_cv_prog_compiler_static_works" = xyes; then : else lt_prog_compiler_static= *************** else *** 6941,6951 **** -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` ! (eval echo "\"\$as_me:6944: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 ! echo "$as_me:6948: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized --- 7683,7693 ---- -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` ! (eval echo "\"\$as_me:7686: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 ! echo "$as_me:7690: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized *************** else *** 6996,7006 **** -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` ! (eval echo "\"\$as_me:6999: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 ! echo "$as_me:7003: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized --- 7738,7748 ---- -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` ! (eval echo "\"\$as_me:7741: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 ! echo "$as_me:7745: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized *************** echo $ECHO_N "checking whether the $comp *** 7090,7105 **** # it will be wrapped by ` (' and `)$', so one must not match beginning or # end of line. Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc', # as well as any symbol that contains `d'. ! exclude_expsyms="_GLOBAL_OFFSET_TABLE_" # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out # platforms (ab)use it in PIC code, but their linkers get confused if # the symbol is explicitly referenced. Since portable code cannot # rely on this symbol name, it's probably fine to never include it in # preloaded symbol tables. extract_expsyms_cmds= case $host_os in ! cygwin* | mingw* | pw32*) # FIXME: the MSVC++ port hasn't been tested in a loooong time # When not using gcc, we currently assume that we are using # Microsoft Visual C++. --- 7832,7848 ---- # it will be wrapped by ` (' and `)$', so one must not match beginning or # end of line. Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc', # as well as any symbol that contains `d'. ! exclude_expsyms='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*' # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out # platforms (ab)use it in PIC code, but their linkers get confused if # the symbol is explicitly referenced. Since portable code cannot # rely on this symbol name, it's probably fine to never include it in # preloaded symbol tables. + # Exclude shared library initialization/finalization symbols. extract_expsyms_cmds= case $host_os in ! cygwin* | mingw* | pw32* | cegcc*) # FIXME: the MSVC++ port hasn't been tested in a loooong time # When not using gcc, we currently assume that we are using # Microsoft Visual C++. *************** _LT_EOF *** 7161,7179 **** ;; amigaos*) ! if test "$host_cpu" = m68k; then ! archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' ! hardcode_libdir_flag_spec='-L$libdir' ! hardcode_minus_L=yes ! fi ! ! # Samuel A. Falvo II reports ! # that the semantics of dynamic libraries on AmigaOS, at least up ! # to version 4, is to share data among multiple programs linked ! # with the same dynamic library. Since this doesn't match the ! # behavior of shared libraries on other platforms, we can't use ! # them. ! ld_shlibs=no ;; beos*) --- 7904,7921 ---- ;; amigaos*) ! case $host_cpu in ! powerpc) ! # see comment about AmigaOS4 .so support ! archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' ! archive_expsym_cmds='' ! ;; ! m68k) ! archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' ! hardcode_libdir_flag_spec='-L$libdir' ! hardcode_minus_L=yes ! ;; ! esac ;; beos*) *************** _LT_EOF *** 7187,7193 **** fi ;; ! cygwin* | mingw* | pw32*) # _LT_TAGVAR(hardcode_libdir_flag_spec, ) is actually meaningless, # as there is no search path for DLLs. hardcode_libdir_flag_spec='-L$libdir' --- 7929,7935 ---- fi ;; ! cygwin* | mingw* | pw32* | cegcc*) # _LT_TAGVAR(hardcode_libdir_flag_spec, ) is actually meaningless, # as there is no search path for DLLs. hardcode_libdir_flag_spec='-L$libdir' *************** _LT_EOF *** 7227,7233 **** archive_expsym_cmds='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' ;; ! gnu* | linux* | tpf* | k*bsd*-gnu) tmp_diet=no if test "$host_os" = linux-dietlibc; then case $cc_basename in --- 7969,7975 ---- archive_expsym_cmds='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' ;; ! gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu) tmp_diet=no if test "$host_os" = linux-dietlibc; then case $cc_basename in *************** _LT_EOF *** 7238,7243 **** --- 7980,7986 ---- && test "$tmp_diet" = no then tmp_addflag= + tmp_sharedflag='-shared' case $cc_basename,$host_cpu in pgcc*) # Portland Group C compiler whole_archive_flag_spec='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; $ECHO \"$new_convenience\"` ${wl}--no-whole-archive' *************** _LT_EOF *** 7252,7257 **** --- 7995,8006 ---- tmp_addflag=' -i_dynamic -nofor_main' ;; ifc* | ifort*) # Intel Fortran compiler tmp_addflag=' -nofor_main' ;; + lf95*) # Lahey Fortran 8.1 + whole_archive_flag_spec= + tmp_sharedflag='--shared' ;; + xl[cC]*) # IBM XL C 8.0 on PPC (deal with xlf below) + tmp_sharedflag='-qmkshrobj' + tmp_addflag= ;; esac case `$CC -V 2>&1 | sed 5q` in *Sun\ C*) # Sun C 5.9 *************** _LT_EOF *** 7260,7267 **** tmp_sharedflag='-G' ;; *Sun\ F*) # Sun Fortran 8.3 tmp_sharedflag='-G' ;; - *) - tmp_sharedflag='-shared' ;; esac archive_cmds='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' --- 8009,8014 ---- *************** _LT_EOF *** 7271,7276 **** --- 8018,8039 ---- echo "local: *; };" >> $output_objdir/$libname.ver~ $CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-version-script ${wl}$output_objdir/$libname.ver -o $lib' fi + + case $cc_basename in + xlf*) + # IBM XL Fortran 10.1 on PPC cannot create shared libs itself + whole_archive_flag_spec='--whole-archive$convenience --no-whole-archive' + hardcode_libdir_flag_spec= + hardcode_libdir_flag_spec_ld='-rpath $libdir' + archive_cmds='$LD -shared $libobjs $deplibs $compiler_flags -soname $soname -o $lib' + if test "x$supports_anon_versioning" = xyes; then + archive_expsym_cmds='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $LD -shared $libobjs $deplibs $compiler_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib' + fi + ;; + esac else ld_shlibs=no fi *************** _LT_EOF *** 7466,7471 **** --- 8229,8235 ---- fi fi + export_dynamic_flag_spec='${wl}-bexpall' # It seems that -bexpall does not export symbols beginning with # underscore (_), so it is better to generate a list of symbols to export. always_export_symbols=yes *************** if test -z "$aix_libpath"; then aix_libp *** 7628,7647 **** ;; amigaos*) ! if test "$host_cpu" = m68k; then ! archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' ! hardcode_libdir_flag_spec='-L$libdir' ! hardcode_minus_L=yes ! fi ! # see comment about different semantics on the GNU ld section ! ld_shlibs=no ;; bsdi[45]*) export_dynamic_flag_spec=-rdynamic ;; ! cygwin* | mingw* | pw32*) # When not using gcc, we currently assume that we are using # Microsoft Visual C++. # hardcode_libdir_flag_spec is actually meaningless, as there is --- 8392,8416 ---- ;; amigaos*) ! case $host_cpu in ! powerpc) ! # see comment about AmigaOS4 .so support ! archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' ! archive_expsym_cmds='' ! ;; ! m68k) ! archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' ! hardcode_libdir_flag_spec='-L$libdir' ! hardcode_minus_L=yes ! ;; ! esac ;; bsdi[45]*) export_dynamic_flag_spec=-rdynamic ;; ! cygwin* | mingw* | pw32* | cegcc*) # When not using gcc, we currently assume that we are using # Microsoft Visual C++. # hardcode_libdir_flag_spec is actually meaningless, as there is *************** if test -z "$aix_libpath"; then aix_libp *** 7663,7735 **** ;; darwin* | rhapsody*) - case $host_os in - rhapsody* | darwin1.[012]) - allow_undefined_flag='${wl}-undefined ${wl}suppress' - ;; - *) # Darwin 1.3 on - case ${MACOSX_DEPLOYMENT_TARGET-10.0} in - 10.[012]) - allow_undefined_flag='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' - ;; - 10.*) - allow_undefined_flag='${wl}-undefined ${wl}dynamic_lookup' - ;; - esac - ;; - esac - archive_cmds_need_lc=no - hardcode_direct=no - hardcode_automatic=yes - hardcode_shlibpath_var=unsupported - whole_archive_flag_spec='' - link_all_deplibs=yes - if test "$GCC" = yes ; then - if test "${lt_cv_apple_cc_single_mod+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 - else - lt_cv_apple_cc_single_mod=no - if test -z "${LT_MULTI_MODULE}"; then - # By default we will add the -single_module flag. You can override - # by either setting the environment variable LT_MULTI_MODULE - # non-empty at configure time, or by adding -multi-module to the - # link flags. - echo "int foo(void){return 1;}" > conftest.c - $LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \ - -dynamiclib ${wl}-single_module conftest.c - if test -f libconftest.dylib; then - lt_cv_apple_cc_single_mod=yes - rm libconftest.dylib - fi - rm conftest.$ac_ext - fi - fi ! output_verbose_link_cmd=echo ! if test "X$lt_cv_apple_cc_single_mod" = Xyes ; then ! archive_cmds='$CC -dynamiclib $single_module $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags -install_name $rpath/$soname $verstring' ! archive_expsym_cmds='sed "s,^,_," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC $single_module -dynamiclib $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags -install_name $rpath/$soname $verstring~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' ! else ! archive_cmds='$CC -dynamiclib $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags -install_name $rpath/$soname $verstring' ! archive_expsym_cmds='sed "s,^,_," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC -dynamiclib $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags -install_name $rpath/$soname $verstring~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' ! fi ! module_cmds='$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags' ! module_expsym_cmds='sed -e "s,^,_," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' ! else ! case $cc_basename in ! xlc*) ! output_verbose_link_cmd=echo ! archive_cmds='$CC -qmkshrobj $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-install_name ${wl}`$ECHO $rpath/$soname` $verstring' ! module_cmds='$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags' ! # Don't fix this by using the ld -exported_symbols_list flag, it doesn't exist in older darwin lds ! archive_expsym_cmds='sed "s,^,_," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC -qmkshrobj $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-install_name ${wl}$rpath/$soname $verstring~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' ! module_expsym_cmds='sed "s,^,_," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' ! ;; ! *) ! ld_shlibs=no ! ;; ! esac ! fi ;; dgux*) --- 8432,8461 ---- ;; darwin* | rhapsody*) ! ! archive_cmds_need_lc=no ! hardcode_direct=no ! hardcode_automatic=yes ! hardcode_shlibpath_var=unsupported ! whole_archive_flag_spec='' ! link_all_deplibs=yes ! allow_undefined_flag="$_lt_dar_allow_undefined" ! case $cc_basename in ! ifort*) _lt_dar_can_shared=yes ;; ! *) _lt_dar_can_shared=$GCC ;; ! esac ! if test "$_lt_dar_can_shared" = "yes"; then ! output_verbose_link_cmd=echo ! archive_cmds="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod${_lt_dsymutil}" ! module_cmds="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dsymutil}" ! archive_expsym_cmds="sed 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring ${_lt_dar_single_mod}${_lt_dar_export_syms}${_lt_dsymutil}" ! module_expsym_cmds="sed -e 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dar_export_syms}${_lt_dsymutil}" ! ! else ! ld_shlibs=no ! fi ! ;; dgux*) *************** fi *** 7811,7817 **** archive_cmds='$CC -shared ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' ;; ia64*) ! archive_cmds='$CC -shared ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' ;; *) archive_cmds='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' --- 8537,8543 ---- archive_cmds='$CC -shared ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' ;; ia64*) ! archive_cmds='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' ;; *) archive_cmds='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' *************** rm -f conftest.err conftest.$ac_objext \ *** 7934,7958 **** ;; openbsd*) ! hardcode_direct=yes ! hardcode_shlibpath_var=no ! hardcode_direct_absolute=yes ! if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then ! archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' ! archive_expsym_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-retain-symbols-file,$export_symbols' ! hardcode_libdir_flag_spec='${wl}-rpath,$libdir' ! export_dynamic_flag_spec='${wl}-E' ! else ! case $host_os in ! openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*) ! archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' ! hardcode_libdir_flag_spec='-R$libdir' ! ;; ! *) archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' hardcode_libdir_flag_spec='${wl}-rpath,$libdir' ! ;; ! esac fi ;; --- 8660,8688 ---- ;; openbsd*) ! if test -f /usr/libexec/ld.so; then ! hardcode_direct=yes ! hardcode_shlibpath_var=no ! hardcode_direct_absolute=yes ! if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-retain-symbols-file,$export_symbols' hardcode_libdir_flag_spec='${wl}-rpath,$libdir' ! export_dynamic_flag_spec='${wl}-E' ! else ! case $host_os in ! openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*) ! archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' ! hardcode_libdir_flag_spec='-R$libdir' ! ;; ! *) ! archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' ! hardcode_libdir_flag_spec='${wl}-rpath,$libdir' ! ;; ! esac ! fi ! else ! ld_shlibs=no fi ;; *************** x|xyes) *** 8189,8232 **** # to ld, don't add -lc before -lgcc. echo "$as_me:$LINENO: checking whether -lc should be explicitly linked in" >&5 echo $ECHO_N "checking whether -lc should be explicitly linked in... $ECHO_C" >&6 ! $RM conftest* ! echo "$lt_simple_compile_test_code" > conftest.$ac_ext ! if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } 2>conftest.err; then ! soname=conftest ! lib=conftest ! libobjs=conftest.$ac_objext ! deplibs= ! wl=$lt_prog_compiler_wl ! pic_flag=$lt_prog_compiler_pic ! compiler_flags=-v ! linker_flags=-v ! verstring= ! output_objdir=. ! libname=conftest ! lt_save_allow_undefined_flag=$allow_undefined_flag ! allow_undefined_flag= ! if { (eval echo "$as_me:$LINENO: \"$archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\"") >&5 (eval $archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } ! then ! archive_cmds_need_lc=no ! else ! archive_cmds_need_lc=yes ! fi ! allow_undefined_flag=$lt_save_allow_undefined_flag ! else ! cat conftest.err 1>&5 ! fi ! $RM conftest* ! echo "$as_me:$LINENO: result: $archive_cmds_need_lc" >&5 ! echo "${ECHO_T}$archive_cmds_need_lc" >&6 ;; esac fi --- 8919,8968 ---- # to ld, don't add -lc before -lgcc. echo "$as_me:$LINENO: checking whether -lc should be explicitly linked in" >&5 echo $ECHO_N "checking whether -lc should be explicitly linked in... $ECHO_C" >&6 ! if test "${lt_cv_archive_cmds_need_lc+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! $RM conftest* ! echo "$lt_simple_compile_test_code" > conftest.$ac_ext ! if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } 2>conftest.err; then ! soname=conftest ! lib=conftest ! libobjs=conftest.$ac_objext ! deplibs= ! wl=$lt_prog_compiler_wl ! pic_flag=$lt_prog_compiler_pic ! compiler_flags=-v ! linker_flags=-v ! verstring= ! output_objdir=. ! libname=conftest ! lt_save_allow_undefined_flag=$allow_undefined_flag ! allow_undefined_flag= ! if { (eval echo "$as_me:$LINENO: \"$archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\"") >&5 (eval $archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } ! then ! lt_cv_archive_cmds_need_lc=no ! else ! lt_cv_archive_cmds_need_lc=yes ! fi ! allow_undefined_flag=$lt_save_allow_undefined_flag ! else ! cat conftest.err 1>&5 ! fi ! $RM conftest* ! ! fi ! echo "$as_me:$LINENO: result: $lt_cv_archive_cmds_need_lc" >&5 ! echo "${ECHO_T}$lt_cv_archive_cmds_need_lc" >&6 ! archive_cmds_need_lc=$lt_cv_archive_cmds_need_lc ;; esac fi *************** esac *** 8391,8398 **** echo "$as_me:$LINENO: checking dynamic linker characteristics" >&5 echo $ECHO_N "checking dynamic linker characteristics... $ECHO_C" >&6 ! withGCC=$GCC ! if test "$withGCC" = yes; then case $host_os in darwin*) lt_awk_arg="/^libraries:/,/LR/" ;; *) lt_awk_arg="/^libraries:/" ;; --- 9127,9134 ---- echo "$as_me:$LINENO: checking dynamic linker characteristics" >&5 echo $ECHO_N "checking dynamic linker characteristics... $ECHO_C" >&6 ! ! if test "$GCC" = yes; then case $host_os in darwin*) lt_awk_arg="/^libraries:/,/LR/" ;; *) lt_awk_arg="/^libraries:/" ;; *************** aix[4-9]*) *** 8518,8530 **** ;; amigaos*) ! if test "$host_cpu" = m68k; then library_names_spec='$libname.ixlibrary $libname.a' # Create ${libname}_ixlibrary.a entries in /sys/libs. finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`$ECHO "X$lib" | $Xsed -e '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' ! else ! dynamic_linker=no ! fi ;; beos*) --- 9254,9271 ---- ;; amigaos*) ! case $host_cpu in ! powerpc) ! # Since July 2007 AmigaOS4 officially supports .so libraries. ! # When compiling the executable, add -use-dynld -Lsobjs: to the compileline. ! library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' ! ;; ! m68k) library_names_spec='$libname.ixlibrary $libname.a' # Create ${libname}_ixlibrary.a entries in /sys/libs. finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`$ECHO "X$lib" | $Xsed -e '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' ! ;; ! esac ;; beos*) *************** bsdi[45]*) *** 8547,8560 **** # libtool to hard-code these into programs ;; ! cygwin* | mingw* | pw32*) version_type=windows shrext_cmds=".dll" need_version=no need_lib_prefix=no ! case $withGCC,$host_os in ! yes,cygwin* | yes,mingw* | yes,pw32*) library_names_spec='$libname.dll.a' # DLL is installed to $(libdir)/../bin by postinstall_cmds postinstall_cmds='base_file=`basename \${file}`~ --- 9288,9301 ---- # libtool to hard-code these into programs ;; ! cygwin* | mingw* | pw32* | cegcc*) version_type=windows shrext_cmds=".dll" need_version=no need_lib_prefix=no ! case $GCC,$host_os in ! yes,cygwin* | yes,mingw* | yes,pw32* | yes,cegcc*) library_names_spec='$libname.dll.a' # DLL is installed to $(libdir)/../bin by postinstall_cmds postinstall_cmds='base_file=`basename \${file}`~ *************** cygwin* | mingw* | pw32*) *** 8577,8583 **** soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' sys_lib_search_path_spec="/usr/lib /lib/w32api /lib /usr/local/lib" ;; ! mingw*) # MinGW DLLs use traditional 'lib' prefix soname_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' sys_lib_search_path_spec=`$CC -print-search-dirs | $GREP "^libraries:" | $SED -e "s/^libraries://" -e "s,=/,/,g"` --- 9318,9324 ---- soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' sys_lib_search_path_spec="/usr/lib /lib/w32api /lib /usr/local/lib" ;; ! mingw* | cegcc*) # MinGW DLLs use traditional 'lib' prefix soname_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' sys_lib_search_path_spec=`$CC -print-search-dirs | $GREP "^libraries:" | $SED -e "s/^libraries://" -e "s,=/,/,g"` *************** linux*oldld* | linux*aout* | linux*coff* *** 8792,8798 **** ;; # This must be Linux ELF. ! linux* | k*bsd*-gnu) version_type=linux need_lib_prefix=no need_version=no --- 9533,9539 ---- ;; # This must be Linux ELF. ! linux* | k*bsd*-gnu | kopensolaris*-gnu) version_type=linux need_lib_prefix=no need_version=no *************** linux* | k*bsd*-gnu) *** 8801,8812 **** finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no # Some binutils ld are patched to set DT_RUNPATH ! save_LDFLAGS=$LDFLAGS ! save_libdir=$libdir ! eval "libdir=/foo; wl=\"$lt_prog_compiler_wl\"; \ ! LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec\"" ! if test x$gcc_no_link = xyes; then { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} { (exit 1); exit 1; }; } --- 9542,9558 ---- finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no + # Some binutils ld are patched to set DT_RUNPATH ! if test "${lt_cv_shlibpath_overrides_runpath+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! lt_cv_shlibpath_overrides_runpath=no ! save_LDFLAGS=$LDFLAGS ! save_libdir=$libdir ! eval "libdir=/foo; wl=\"$lt_prog_compiler_wl\"; \ ! LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec\"" ! if test x$gcc_no_link = xyes; then { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} { (exit 1); exit 1; }; } *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 8848,8855 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! if ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir"; then ! shlibpath_overrides_runpath=yes fi else --- 9594,9601 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! if ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then ! lt_cv_shlibpath_overrides_runpath=yes fi else *************** sed 's/^/| /' conftest.$ac_ext >&5 *** 8859,8866 **** fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext ! LDFLAGS=$save_LDFLAGS ! libdir=$save_libdir # This implies no fast_install, which is unacceptable. # Some rework will be needed to allow for fast_install --- 9605,9616 ---- fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext ! LDFLAGS=$save_LDFLAGS ! libdir=$save_libdir ! ! fi ! ! shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath # This implies no fast_install, which is unacceptable. # Some rework will be needed to allow for fast_install *************** rm -f conftest.err conftest.$ac_objext \ *** 8869,8875 **** # Append ld.so.conf contents to the search path if test -f /etc/ld.so.conf; then ! lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;/^$/d' | tr '\n' ' '` sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra" fi --- 9619,9625 ---- # Append ld.so.conf contents to the search path if test -f /etc/ld.so.conf; then ! lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;/^$/d' | tr '\n' ' '` sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra" fi *************** tpf*) *** 9053,9059 **** version_type=linux need_lib_prefix=no need_version=no ! library_name_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no hardcode_into_libs=yes --- 9803,9809 ---- version_type=linux need_lib_prefix=no need_version=no ! library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no hardcode_into_libs=yes *************** if test "$GCC" = yes; then *** 9079,9084 **** --- 9829,9841 ---- variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" fi + if test "${lt_cv_sys_lib_search_path_spec+set}" = set; then + sys_lib_search_path_spec="$lt_cv_sys_lib_search_path_spec" + fi + if test "${lt_cv_sys_lib_dlsearch_path_spec+set}" = set; then + sys_lib_dlsearch_path_spec="$lt_cv_sys_lib_dlsearch_path_spec" + fi + *************** else *** 9223,9229 **** lt_cv_dlopen_self=yes ;; ! mingw* | pw32*) lt_cv_dlopen="LoadLibrary" lt_cv_dlopen_libs= ;; --- 9980,9986 ---- lt_cv_dlopen_self=yes ;; ! mingw* | pw32* | cegcc*) lt_cv_dlopen="LoadLibrary" lt_cv_dlopen_libs= ;; *************** fi *** 9485,9491 **** echo "$as_me:$LINENO: result: $ac_cv_lib_dld_shl_load" >&5 echo "${ECHO_T}$ac_cv_lib_dld_shl_load" >&6 if test $ac_cv_lib_dld_shl_load = yes; then ! lt_cv_dlopen="shl_load" lt_cv_dlopen_libs="-dld" else echo "$as_me:$LINENO: checking for dlopen" >&5 echo $ECHO_N "checking for dlopen... $ECHO_C" >&6 --- 10242,10248 ---- echo "$as_me:$LINENO: result: $ac_cv_lib_dld_shl_load" >&5 echo "${ECHO_T}$ac_cv_lib_dld_shl_load" >&6 if test $ac_cv_lib_dld_shl_load = yes; then ! lt_cv_dlopen="shl_load" lt_cv_dlopen_libs="-ldld" else echo "$as_me:$LINENO: checking for dlopen" >&5 echo $ECHO_N "checking for dlopen... $ECHO_C" >&6 *************** fi *** 9799,9805 **** echo "$as_me:$LINENO: result: $ac_cv_lib_dld_dld_link" >&5 echo "${ECHO_T}$ac_cv_lib_dld_dld_link" >&6 if test $ac_cv_lib_dld_dld_link = yes; then ! lt_cv_dlopen="dld_link" lt_cv_dlopen_libs="-dld" fi --- 10556,10562 ---- echo "$as_me:$LINENO: result: $ac_cv_lib_dld_dld_link" >&5 echo "${ECHO_T}$ac_cv_lib_dld_dld_link" >&6 if test $ac_cv_lib_dld_dld_link = yes; then ! lt_cv_dlopen="dld_link" lt_cv_dlopen_libs="-ldld" fi *************** else *** 9848,9854 **** lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_status=$lt_dlunknown cat > conftest.$ac_ext <<_LT_EOF ! #line 9851 "configure" #include "confdefs.h" #if HAVE_DLFCN_H --- 10605,10611 ---- lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_status=$lt_dlunknown cat > conftest.$ac_ext <<_LT_EOF ! #line 10608 "configure" #include "confdefs.h" #if HAVE_DLFCN_H *************** else *** 9889,9898 **** # endif #endif - #ifdef __cplusplus - extern "C" void exit (int); - #endif - void fnord() { int i=42;} int main () { --- 10646,10651 ---- *************** int main () *** 9908,9914 **** else puts (dlerror ()); ! exit (status); } _LT_EOF if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 --- 10661,10667 ---- else puts (dlerror ()); ! return status; } _LT_EOF if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 *************** else *** 9948,9954 **** lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_status=$lt_dlunknown cat > conftest.$ac_ext <<_LT_EOF ! #line 9951 "configure" #include "confdefs.h" #if HAVE_DLFCN_H --- 10701,10707 ---- lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_status=$lt_dlunknown cat > conftest.$ac_ext <<_LT_EOF ! #line 10704 "configure" #include "confdefs.h" #if HAVE_DLFCN_H *************** else *** 9989,9998 **** # endif #endif - #ifdef __cplusplus - extern "C" void exit (int); - #endif - void fnord() { int i=42;} int main () { --- 10742,10747 ---- *************** int main () *** 10008,10014 **** else puts (dlerror ()); ! exit (status); } _LT_EOF if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 --- 10757,10763 ---- else puts (dlerror ()); ! return status; } _LT_EOF if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 *************** fi *** 10278,10284 **** # Provide some information about the compiler. ! echo "$as_me:10281:" \ "checking for Fortran compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 --- 11027,11033 ---- # Provide some information about the compiler. ! echo "$as_me:11030:" \ "checking for Fortran compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 *************** fi *** 10514,10520 **** # Provide some information about the compiler. ! echo "$as_me:10517:" \ "checking for Fortran compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 --- 11263,11269 ---- # Provide some information about the compiler. ! echo "$as_me:11266:" \ "checking for Fortran compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 *************** $RM conftest* *** 10743,10755 **** echo "$lt_simple_link_test_code" >conftest.$ac_ext eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err _lt_linker_boilerplate=`cat conftest.err` ! $RM conftest* # Allow CC to be a program name with arguments. lt_save_CC="$CC" CC=${FC-"f95"} compiler=$CC compiler_FC=$CC for cc_temp in $compiler""; do case $cc_temp in --- 11492,11507 ---- echo "$lt_simple_link_test_code" >conftest.$ac_ext eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err _lt_linker_boilerplate=`cat conftest.err` ! $RM -r conftest* # Allow CC to be a program name with arguments. lt_save_CC="$CC" + lt_save_GCC=$GCC CC=${FC-"f95"} compiler=$CC + GCC=$ac_cv_fc_compiler_gnu + compiler_FC=$CC for cc_temp in $compiler""; do case $cc_temp in *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 10833,10844 **** # the conftest object file. pre_test_object_deps_done=no ! # The `*' in the case matches for architectures that use `case' in ! # $output_verbose_cmd can trigger glob expansion during the loop ! # eval without this substitution. ! output_verbose_link_cmd=`$ECHO "X$output_verbose_link_cmd" | $Xsed -e "$no_glob_subst"` ! ! for p in `eval $output_verbose_link_cmd`; do case $p in -L* | -R* | -l*) --- 11585,11591 ---- # the conftest object file. pre_test_object_deps_done=no ! for p in `eval "$output_verbose_link_cmd"`; do case $p in -L* | -R* | -l*) *************** $RM -f confest.$objext *** 10918,10923 **** --- 11665,11679 ---- case " $postdeps_FC " in *" -lc "*) archive_cmds_need_lc_FC=no ;; esac + compiler_lib_search_dirs_FC= + if test -n "${compiler_lib_search_path_FC}"; then + compiler_lib_search_dirs_FC=`echo " ${compiler_lib_search_path_FC}" | ${SED} -e 's! -L! !g' -e 's!^ !!'` + fi + + + + + *************** echo $ECHO_N "checking for $compiler opt *** 10965,10983 **** ;; amigaos*) ! if test "$host_cpu" = m68k; then ! # FIXME: we need at least 68020 code to build shared libraries, but ! # adding the `-m68020' flag to GCC prevents building anything better, ! # like `-m68040'. ! lt_prog_compiler_pic_FC='-m68020 -resident32 -malways-restore-a4' ! fi ;; beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) # PIC is the default for these OSes. ;; ! mingw* | cygwin* | pw32* | os2*) # This hack is so that the source file can tell whether it is being # built for inclusion in a dll (and should export symbols for example). # Although the cygwin gcc ignores -fPIC, still need this for old-style --- 11721,11745 ---- ;; amigaos*) ! case $host_cpu in ! powerpc) ! # see comment about AmigaOS4 .so support ! lt_prog_compiler_pic_FC='-fPIC' ! ;; ! m68k) ! # FIXME: we need at least 68020 code to build shared libraries, but ! # adding the `-m68020' flag to GCC prevents building anything better, ! # like `-m68040'. ! lt_prog_compiler_pic_FC='-m68020 -resident32 -malways-restore-a4' ! ;; ! esac ;; beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) # PIC is the default for these OSes. ;; ! mingw* | cygwin* | pw32* | os2* | cegcc*) # This hack is so that the source file can tell whether it is being # built for inclusion in a dll (and should export symbols for example). # Although the cygwin gcc ignores -fPIC, still need this for old-style *************** echo $ECHO_N "checking for $compiler opt *** 10992,11001 **** ;; hpux*) ! # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but ! # not for PA HP-UX. case $host_cpu in ! hppa*64*|ia64*) # +Z the default ;; *) --- 11754,11764 ---- ;; hpux*) ! # PIC is the default for 64-bit PA HP-UX, but not for 32-bit ! # PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag ! # sets the default TLS model and affects inlining. case $host_cpu in ! hppa*64*) # +Z the default ;; *) *************** echo $ECHO_N "checking for $compiler opt *** 11044,11061 **** lt_prog_compiler_static_FC='-bnso -bI:/lib/syscalls.exp' fi ;; - darwin*) - # PIC is the default on this platform - # Common symbols not allowed in MH_DYLIB files - case $cc_basename in - xlc*) - lt_prog_compiler_pic_FC='-qnocommon' - lt_prog_compiler_wl_FC='-Wl,' - ;; - esac - ;; ! mingw* | cygwin* | pw32* | os2*) # This hack is so that the source file can tell whether it is being # built for inclusion in a dll (and should export symbols for example). lt_prog_compiler_pic_FC='-DDLL_EXPORT' --- 11807,11814 ---- lt_prog_compiler_static_FC='-bnso -bI:/lib/syscalls.exp' fi ;; ! mingw* | cygwin* | pw32* | os2* | cegcc*) # This hack is so that the source file can tell whether it is being # built for inclusion in a dll (and should export symbols for example). lt_prog_compiler_pic_FC='-DDLL_EXPORT' *************** echo $ECHO_N "checking for $compiler opt *** 11083,11095 **** lt_prog_compiler_static_FC='-non_shared' ;; ! linux* | k*bsd*-gnu) case $cc_basename in ! icc* | ecc*) lt_prog_compiler_wl_FC='-Wl,' lt_prog_compiler_pic_FC='-KPIC' lt_prog_compiler_static_FC='-static' ;; pgcc* | pgf77* | pgf90* | pgf95*) # Portland Group compilers (*not* the Pentium gcc compiler, # which looks to be a dead project) --- 11836,11862 ---- lt_prog_compiler_static_FC='-non_shared' ;; ! linux* | k*bsd*-gnu | kopensolaris*-gnu) case $cc_basename in ! # old Intel for x86_64 which still supported -KPIC. ! ecc*) lt_prog_compiler_wl_FC='-Wl,' lt_prog_compiler_pic_FC='-KPIC' lt_prog_compiler_static_FC='-static' ;; + # icc used to be incompatible with GCC. + # ICC 10 doesn't accept -KPIC any more. + icc* | ifort*) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='-fPIC' + lt_prog_compiler_static_FC='-static' + ;; + # Lahey Fortran 8.1. + lf95*) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='--shared' + lt_prog_compiler_static_FC='--static' + ;; pgcc* | pgf77* | pgf90* | pgf95*) # Portland Group compilers (*not* the Pentium gcc compiler, # which looks to be a dead project) *************** echo $ECHO_N "checking for $compiler opt *** 11102,11107 **** --- 11869,11880 ---- # All Alpha code is PIC. lt_prog_compiler_static_FC='-non_shared' ;; + xl*) + # IBM XL C 8.0/Fortran 10.1 on PPC + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='-qpic' + lt_prog_compiler_static_FC='-qstaticlink' + ;; *) case `$CC -V 2>&1 | sed 5q` in *Sun\ C*) *************** echo "${ECHO_T}$lt_prog_compiler_pic_FC" *** 11214,11223 **** if test -n "$lt_prog_compiler_pic_FC"; then echo "$as_me:$LINENO: checking if $compiler PIC flag $lt_prog_compiler_pic_FC works" >&5 echo $ECHO_N "checking if $compiler PIC flag $lt_prog_compiler_pic_FC works... $ECHO_C" >&6 ! if test "${lt_prog_compiler_pic_works_FC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ! lt_prog_compiler_pic_works_FC=no ac_outfile=conftest.$ac_objext echo "$lt_simple_compile_test_code" > conftest.$ac_ext lt_compiler_flag="$lt_prog_compiler_pic_FC" --- 11987,11996 ---- if test -n "$lt_prog_compiler_pic_FC"; then echo "$as_me:$LINENO: checking if $compiler PIC flag $lt_prog_compiler_pic_FC works" >&5 echo $ECHO_N "checking if $compiler PIC flag $lt_prog_compiler_pic_FC works... $ECHO_C" >&6 ! if test "${lt_cv_prog_compiler_pic_works_FC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ! lt_cv_prog_compiler_pic_works_FC=no ac_outfile=conftest.$ac_objext echo "$lt_simple_compile_test_code" > conftest.$ac_ext lt_compiler_flag="$lt_prog_compiler_pic_FC" *************** else *** 11230,11256 **** -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` ! (eval echo "\"\$as_me:11233: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 ! echo "$as_me:11237: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings other than the usual output. $ECHO "X$_lt_compiler_boilerplate" | $Xsed -e '/^$/d' >conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then ! lt_prog_compiler_pic_works_FC=yes fi fi $RM conftest* fi ! echo "$as_me:$LINENO: result: $lt_prog_compiler_pic_works_FC" >&5 ! echo "${ECHO_T}$lt_prog_compiler_pic_works_FC" >&6 ! if test x"$lt_prog_compiler_pic_works_FC" = xyes; then case $lt_prog_compiler_pic_FC in "" | " "*) ;; *) lt_prog_compiler_pic_FC=" $lt_prog_compiler_pic_FC" ;; --- 12003,12029 ---- -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` ! (eval echo "\"\$as_me:12006: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 ! echo "$as_me:12010: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings other than the usual output. $ECHO "X$_lt_compiler_boilerplate" | $Xsed -e '/^$/d' >conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then ! lt_cv_prog_compiler_pic_works_FC=yes fi fi $RM conftest* fi ! echo "$as_me:$LINENO: result: $lt_cv_prog_compiler_pic_works_FC" >&5 ! echo "${ECHO_T}$lt_cv_prog_compiler_pic_works_FC" >&6 ! if test x"$lt_cv_prog_compiler_pic_works_FC" = xyes; then case $lt_prog_compiler_pic_FC in "" | " "*) ;; *) lt_prog_compiler_pic_FC=" $lt_prog_compiler_pic_FC" ;; *************** fi *** 11270,11279 **** wl=$lt_prog_compiler_wl_FC eval lt_tmp_static_flag=\"$lt_prog_compiler_static_FC\" echo "$as_me:$LINENO: checking if $compiler static flag $lt_tmp_static_flag works" >&5 echo $ECHO_N "checking if $compiler static flag $lt_tmp_static_flag works... $ECHO_C" >&6 ! if test "${lt_prog_compiler_static_works_FC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ! lt_prog_compiler_static_works_FC=no save_LDFLAGS="$LDFLAGS" LDFLAGS="$LDFLAGS $lt_tmp_static_flag" echo "$lt_simple_link_test_code" > conftest.$ac_ext --- 12043,12052 ---- wl=$lt_prog_compiler_wl_FC eval lt_tmp_static_flag=\"$lt_prog_compiler_static_FC\" echo "$as_me:$LINENO: checking if $compiler static flag $lt_tmp_static_flag works" >&5 echo $ECHO_N "checking if $compiler static flag $lt_tmp_static_flag works... $ECHO_C" >&6 ! if test "${lt_cv_prog_compiler_static_works_FC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ! lt_cv_prog_compiler_static_works_FC=no save_LDFLAGS="$LDFLAGS" LDFLAGS="$LDFLAGS $lt_tmp_static_flag" echo "$lt_simple_link_test_code" > conftest.$ac_ext *************** else *** 11286,11305 **** $ECHO "X$_lt_linker_boilerplate" | $Xsed -e '/^$/d' > conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if diff conftest.exp conftest.er2 >/dev/null; then ! lt_prog_compiler_static_works_FC=yes fi else ! lt_prog_compiler_static_works_FC=yes fi fi ! $RM conftest* LDFLAGS="$save_LDFLAGS" fi ! echo "$as_me:$LINENO: result: $lt_prog_compiler_static_works_FC" >&5 ! echo "${ECHO_T}$lt_prog_compiler_static_works_FC" >&6 ! if test x"$lt_prog_compiler_static_works_FC" = xyes; then : else lt_prog_compiler_static_FC= --- 12059,12078 ---- $ECHO "X$_lt_linker_boilerplate" | $Xsed -e '/^$/d' > conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if diff conftest.exp conftest.er2 >/dev/null; then ! lt_cv_prog_compiler_static_works_FC=yes fi else ! lt_cv_prog_compiler_static_works_FC=yes fi fi ! $RM -r conftest* LDFLAGS="$save_LDFLAGS" fi ! echo "$as_me:$LINENO: result: $lt_cv_prog_compiler_static_works_FC" >&5 ! echo "${ECHO_T}$lt_cv_prog_compiler_static_works_FC" >&6 ! if test x"$lt_cv_prog_compiler_static_works_FC" = xyes; then : else lt_prog_compiler_static_FC= *************** else *** 11329,11339 **** -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` ! (eval echo "\"\$as_me:11332: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 ! echo "$as_me:11336: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized --- 12102,12112 ---- -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` ! (eval echo "\"\$as_me:12105: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 ! echo "$as_me:12109: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized *************** else *** 11381,11391 **** -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` ! (eval echo "\"\$as_me:11384: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 ! echo "$as_me:11388: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized --- 12154,12164 ---- -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` ! (eval echo "\"\$as_me:12157: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 ! echo "$as_me:12161: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized *************** echo $ECHO_N "checking whether the $comp *** 11472,11487 **** # it will be wrapped by ` (' and `)$', so one must not match beginning or # end of line. Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc', # as well as any symbol that contains `d'. ! exclude_expsyms_FC="_GLOBAL_OFFSET_TABLE_" # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out # platforms (ab)use it in PIC code, but their linkers get confused if # the symbol is explicitly referenced. Since portable code cannot # rely on this symbol name, it's probably fine to never include it in # preloaded symbol tables. extract_expsyms_cmds= case $host_os in ! cygwin* | mingw* | pw32*) # FIXME: the MSVC++ port hasn't been tested in a loooong time # When not using gcc, we currently assume that we are using # Microsoft Visual C++. --- 12245,12261 ---- # it will be wrapped by ` (' and `)$', so one must not match beginning or # end of line. Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc', # as well as any symbol that contains `d'. ! exclude_expsyms_FC='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*' # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out # platforms (ab)use it in PIC code, but their linkers get confused if # the symbol is explicitly referenced. Since portable code cannot # rely on this symbol name, it's probably fine to never include it in # preloaded symbol tables. + # Exclude shared library initialization/finalization symbols. extract_expsyms_cmds= case $host_os in ! cygwin* | mingw* | pw32* | cegcc*) # FIXME: the MSVC++ port hasn't been tested in a loooong time # When not using gcc, we currently assume that we are using # Microsoft Visual C++. *************** _LT_EOF *** 11543,11561 **** ;; amigaos*) ! if test "$host_cpu" = m68k; then ! archive_cmds_FC='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' ! hardcode_libdir_flag_spec_FC='-L$libdir' ! hardcode_minus_L_FC=yes ! fi ! ! # Samuel A. Falvo II reports ! # that the semantics of dynamic libraries on AmigaOS, at least up ! # to version 4, is to share data among multiple programs linked ! # with the same dynamic library. Since this doesn't match the ! # behavior of shared libraries on other platforms, we can't use ! # them. ! ld_shlibs_FC=no ;; beos*) --- 12317,12334 ---- ;; amigaos*) ! case $host_cpu in ! powerpc) ! # see comment about AmigaOS4 .so support ! archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' ! archive_expsym_cmds_FC='' ! ;; ! m68k) ! archive_cmds_FC='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' ! hardcode_libdir_flag_spec_FC='-L$libdir' ! hardcode_minus_L_FC=yes ! ;; ! esac ;; beos*) *************** _LT_EOF *** 11569,11575 **** fi ;; ! cygwin* | mingw* | pw32*) # _LT_TAGVAR(hardcode_libdir_flag_spec, FC) is actually meaningless, # as there is no search path for DLLs. hardcode_libdir_flag_spec_FC='-L$libdir' --- 12342,12348 ---- fi ;; ! cygwin* | mingw* | pw32* | cegcc*) # _LT_TAGVAR(hardcode_libdir_flag_spec, FC) is actually meaningless, # as there is no search path for DLLs. hardcode_libdir_flag_spec_FC='-L$libdir' *************** _LT_EOF *** 11609,11615 **** archive_expsym_cmds_FC='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' ;; ! gnu* | linux* | tpf* | k*bsd*-gnu) tmp_diet=no if test "$host_os" = linux-dietlibc; then case $cc_basename in --- 12382,12388 ---- archive_expsym_cmds_FC='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' ;; ! gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu) tmp_diet=no if test "$host_os" = linux-dietlibc; then case $cc_basename in *************** _LT_EOF *** 11620,11625 **** --- 12393,12399 ---- && test "$tmp_diet" = no then tmp_addflag= + tmp_sharedflag='-shared' case $cc_basename,$host_cpu in pgcc*) # Portland Group C compiler whole_archive_flag_spec_FC='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; $ECHO \"$new_convenience\"` ${wl}--no-whole-archive' *************** _LT_EOF *** 11634,11639 **** --- 12408,12419 ---- tmp_addflag=' -i_dynamic -nofor_main' ;; ifc* | ifort*) # Intel Fortran compiler tmp_addflag=' -nofor_main' ;; + lf95*) # Lahey Fortran 8.1 + whole_archive_flag_spec_FC= + tmp_sharedflag='--shared' ;; + xl[cC]*) # IBM XL C 8.0 on PPC (deal with xlf below) + tmp_sharedflag='-qmkshrobj' + tmp_addflag= ;; esac case `$CC -V 2>&1 | sed 5q` in *Sun\ C*) # Sun C 5.9 *************** _LT_EOF *** 11642,11649 **** tmp_sharedflag='-G' ;; *Sun\ F*) # Sun Fortran 8.3 tmp_sharedflag='-G' ;; - *) - tmp_sharedflag='-shared' ;; esac archive_cmds_FC='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' --- 12422,12427 ---- *************** _LT_EOF *** 11653,11658 **** --- 12431,12452 ---- echo "local: *; };" >> $output_objdir/$libname.ver~ $CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-version-script ${wl}$output_objdir/$libname.ver -o $lib' fi + + case $cc_basename in + xlf*) + # IBM XL Fortran 10.1 on PPC cannot create shared libs itself + whole_archive_flag_spec_FC='--whole-archive$convenience --no-whole-archive' + hardcode_libdir_flag_spec_FC= + hardcode_libdir_flag_spec_ld_FC='-rpath $libdir' + archive_cmds_FC='$LD -shared $libobjs $deplibs $compiler_flags -soname $soname -o $lib' + if test "x$supports_anon_versioning" = xyes; then + archive_expsym_cmds_FC='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $LD -shared $libobjs $deplibs $compiler_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib' + fi + ;; + esac else ld_shlibs_FC=no fi *************** _LT_EOF *** 11848,11853 **** --- 12642,12648 ---- fi fi + export_dynamic_flag_spec_FC='${wl}-bexpall' # It seems that -bexpall does not export symbols beginning with # underscore (_), so it is better to generate a list of symbols to export. always_export_symbols_FC=yes *************** if test -z "$aix_libpath"; then aix_libp *** 11990,12009 **** ;; amigaos*) ! if test "$host_cpu" = m68k; then ! archive_cmds_FC='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' ! hardcode_libdir_flag_spec_FC='-L$libdir' ! hardcode_minus_L_FC=yes ! fi ! # see comment about different semantics on the GNU ld section ! ld_shlibs_FC=no ;; bsdi[45]*) export_dynamic_flag_spec_FC=-rdynamic ;; ! cygwin* | mingw* | pw32*) # When not using gcc, we currently assume that we are using # Microsoft Visual C++. # hardcode_libdir_flag_spec is actually meaningless, as there is --- 12785,12809 ---- ;; amigaos*) ! case $host_cpu in ! powerpc) ! # see comment about AmigaOS4 .so support ! archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' ! archive_expsym_cmds_FC='' ! ;; ! m68k) ! archive_cmds_FC='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' ! hardcode_libdir_flag_spec_FC='-L$libdir' ! hardcode_minus_L_FC=yes ! ;; ! esac ;; bsdi[45]*) export_dynamic_flag_spec_FC=-rdynamic ;; ! cygwin* | mingw* | pw32* | cegcc*) # When not using gcc, we currently assume that we are using # Microsoft Visual C++. # hardcode_libdir_flag_spec is actually meaningless, as there is *************** if test -z "$aix_libpath"; then aix_libp *** 12025,12097 **** ;; darwin* | rhapsody*) - case $host_os in - rhapsody* | darwin1.[012]) - allow_undefined_flag_FC='${wl}-undefined ${wl}suppress' - ;; - *) # Darwin 1.3 on - case ${MACOSX_DEPLOYMENT_TARGET-10.0} in - 10.[012]) - allow_undefined_flag_FC='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' - ;; - 10.*) - allow_undefined_flag_FC='${wl}-undefined ${wl}dynamic_lookup' - ;; - esac - ;; - esac - archive_cmds_need_lc_FC=no - hardcode_direct_FC=no - hardcode_automatic_FC=yes - hardcode_shlibpath_var_FC=unsupported - whole_archive_flag_spec_FC='' - link_all_deplibs_FC=yes - if test "$GCC" = yes ; then - if test "${lt_cv_apple_cc_single_mod+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 - else - lt_cv_apple_cc_single_mod=no - if test -z "${LT_MULTI_MODULE}"; then - # By default we will add the -single_module flag. You can override - # by either setting the environment variable LT_MULTI_MODULE - # non-empty at configure time, or by adding -multi-module to the - # link flags. - echo "int foo(void){return 1;}" > conftest.c - $LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \ - -dynamiclib ${wl}-single_module conftest.c - if test -f libconftest.dylib; then - lt_cv_apple_cc_single_mod=yes - rm libconftest.dylib - fi - rm conftest.$ac_ext - fi - fi ! output_verbose_link_cmd=echo ! if test "X$lt_cv_apple_cc_single_mod" = Xyes ; then ! archive_cmds_FC='$CC -dynamiclib $single_module $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags -install_name $rpath/$soname $verstring' ! archive_expsym_cmds_FC='sed "s,^,_," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC $single_module -dynamiclib $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags -install_name $rpath/$soname $verstring~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' ! else ! archive_cmds_FC='$CC -dynamiclib $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags -install_name $rpath/$soname $verstring' ! archive_expsym_cmds_FC='sed "s,^,_," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC -dynamiclib $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags -install_name $rpath/$soname $verstring~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' ! fi ! module_cmds_FC='$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags' ! module_expsym_cmds_FC='sed -e "s,^,_," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' ! else ! case $cc_basename in ! xlc*) ! output_verbose_link_cmd=echo ! archive_cmds_FC='$CC -qmkshrobj $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-install_name ${wl}`$ECHO $rpath/$soname` $verstring' ! module_cmds_FC='$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags' ! # Don't fix this by using the ld -exported_symbols_list flag, it doesn't exist in older darwin lds ! archive_expsym_cmds_FC='sed "s,^,_," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC -qmkshrobj $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-install_name ${wl}$rpath/$soname $verstring~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' ! module_expsym_cmds_FC='sed "s,^,_," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' ! ;; ! *) ! ld_shlibs_FC=no ! ;; ! esac ! fi ;; dgux*) --- 12825,12854 ---- ;; darwin* | rhapsody*) ! ! archive_cmds_need_lc_FC=no ! hardcode_direct_FC=no ! hardcode_automatic_FC=yes ! hardcode_shlibpath_var_FC=unsupported ! whole_archive_flag_spec_FC='' ! link_all_deplibs_FC=yes ! allow_undefined_flag_FC="$_lt_dar_allow_undefined" ! case $cc_basename in ! ifort*) _lt_dar_can_shared=yes ;; ! *) _lt_dar_can_shared=$GCC ;; ! esac ! if test "$_lt_dar_can_shared" = "yes"; then ! output_verbose_link_cmd=echo ! archive_cmds_FC="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod${_lt_dsymutil}" ! module_cmds_FC="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dsymutil}" ! archive_expsym_cmds_FC="sed 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring ${_lt_dar_single_mod}${_lt_dar_export_syms}${_lt_dsymutil}" ! module_expsym_cmds_FC="sed -e 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dar_export_syms}${_lt_dsymutil}" ! ! else ! ld_shlibs_FC=no ! fi ! ;; dgux*) *************** fi *** 12173,12179 **** archive_cmds_FC='$CC -shared ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' ;; ia64*) ! archive_cmds_FC='$CC -shared ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' ;; *) archive_cmds_FC='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' --- 12930,12936 ---- archive_cmds_FC='$CC -shared ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' ;; ia64*) ! archive_cmds_FC='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' ;; *) archive_cmds_FC='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' *************** rm -f conftest.err conftest.$ac_objext \ *** 12296,12320 **** ;; openbsd*) ! hardcode_direct_FC=yes ! hardcode_shlibpath_var_FC=no ! hardcode_direct_absolute_FC=yes ! if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then ! archive_cmds_FC='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' ! archive_expsym_cmds_FC='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-retain-symbols-file,$export_symbols' ! hardcode_libdir_flag_spec_FC='${wl}-rpath,$libdir' ! export_dynamic_flag_spec_FC='${wl}-E' ! else ! case $host_os in ! openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*) ! archive_cmds_FC='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' ! hardcode_libdir_flag_spec_FC='-R$libdir' ! ;; ! *) archive_cmds_FC='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' hardcode_libdir_flag_spec_FC='${wl}-rpath,$libdir' ! ;; ! esac fi ;; --- 13053,13081 ---- ;; openbsd*) ! if test -f /usr/libexec/ld.so; then ! hardcode_direct_FC=yes ! hardcode_shlibpath_var_FC=no ! hardcode_direct_absolute_FC=yes ! if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then archive_cmds_FC='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_FC='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-retain-symbols-file,$export_symbols' hardcode_libdir_flag_spec_FC='${wl}-rpath,$libdir' ! export_dynamic_flag_spec_FC='${wl}-E' ! else ! case $host_os in ! openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*) ! archive_cmds_FC='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' ! hardcode_libdir_flag_spec_FC='-R$libdir' ! ;; ! *) ! archive_cmds_FC='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' ! hardcode_libdir_flag_spec_FC='${wl}-rpath,$libdir' ! ;; ! esac ! fi ! else ! ld_shlibs_FC=no fi ;; *************** x|xyes) *** 12542,12585 **** # to ld, don't add -lc before -lgcc. echo "$as_me:$LINENO: checking whether -lc should be explicitly linked in" >&5 echo $ECHO_N "checking whether -lc should be explicitly linked in... $ECHO_C" >&6 ! $RM conftest* ! echo "$lt_simple_compile_test_code" > conftest.$ac_ext ! if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } 2>conftest.err; then ! soname=conftest ! lib=conftest ! libobjs=conftest.$ac_objext ! deplibs= ! wl=$lt_prog_compiler_wl_FC ! pic_flag=$lt_prog_compiler_pic_FC ! compiler_flags=-v ! linker_flags=-v ! verstring= ! output_objdir=. ! libname=conftest ! lt_save_allow_undefined_flag=$allow_undefined_flag_FC ! allow_undefined_flag_FC= ! if { (eval echo "$as_me:$LINENO: \"$archive_cmds_FC 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\"") >&5 (eval $archive_cmds_FC 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } ! then ! archive_cmds_need_lc_FC=no ! else ! archive_cmds_need_lc_FC=yes ! fi ! allow_undefined_flag_FC=$lt_save_allow_undefined_flag ! else ! cat conftest.err 1>&5 ! fi ! $RM conftest* ! echo "$as_me:$LINENO: result: $archive_cmds_need_lc_FC" >&5 ! echo "${ECHO_T}$archive_cmds_need_lc_FC" >&6 ;; esac fi --- 13303,13352 ---- # to ld, don't add -lc before -lgcc. echo "$as_me:$LINENO: checking whether -lc should be explicitly linked in" >&5 echo $ECHO_N "checking whether -lc should be explicitly linked in... $ECHO_C" >&6 ! if test "${lt_cv_archive_cmds_need_lc_FC+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! $RM conftest* ! echo "$lt_simple_compile_test_code" > conftest.$ac_ext ! if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } 2>conftest.err; then ! soname=conftest ! lib=conftest ! libobjs=conftest.$ac_objext ! deplibs= ! wl=$lt_prog_compiler_wl_FC ! pic_flag=$lt_prog_compiler_pic_FC ! compiler_flags=-v ! linker_flags=-v ! verstring= ! output_objdir=. ! libname=conftest ! lt_save_allow_undefined_flag=$allow_undefined_flag_FC ! allow_undefined_flag_FC= ! if { (eval echo "$as_me:$LINENO: \"$archive_cmds_FC 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\"") >&5 (eval $archive_cmds_FC 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } ! then ! lt_cv_archive_cmds_need_lc_FC=no ! else ! lt_cv_archive_cmds_need_lc_FC=yes ! fi ! allow_undefined_flag_FC=$lt_save_allow_undefined_flag ! else ! cat conftest.err 1>&5 ! fi ! $RM conftest* ! ! fi ! echo "$as_me:$LINENO: result: $lt_cv_archive_cmds_need_lc_FC" >&5 ! echo "${ECHO_T}$lt_cv_archive_cmds_need_lc_FC" >&6 ! archive_cmds_need_lc_FC=$lt_cv_archive_cmds_need_lc_FC ;; esac fi *************** esac *** 12651,12657 **** echo "$as_me:$LINENO: checking dynamic linker characteristics" >&5 echo $ECHO_N "checking dynamic linker characteristics... $ECHO_C" >&6 ! withGCC=$ac_cv_fc_compiler_gnu library_names_spec= libname_spec='lib$name' soname_spec= --- 13418,13424 ---- echo "$as_me:$LINENO: checking dynamic linker characteristics" >&5 echo $ECHO_N "checking dynamic linker characteristics... $ECHO_C" >&6 ! library_names_spec= libname_spec='lib$name' soname_spec= *************** aix[4-9]*) *** 12727,12739 **** ;; amigaos*) ! if test "$host_cpu" = m68k; then library_names_spec='$libname.ixlibrary $libname.a' # Create ${libname}_ixlibrary.a entries in /sys/libs. finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`$ECHO "X$lib" | $Xsed -e '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' ! else ! dynamic_linker=no ! fi ;; beos*) --- 13494,13511 ---- ;; amigaos*) ! case $host_cpu in ! powerpc) ! # Since July 2007 AmigaOS4 officially supports .so libraries. ! # When compiling the executable, add -use-dynld -Lsobjs: to the compileline. ! library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' ! ;; ! m68k) library_names_spec='$libname.ixlibrary $libname.a' # Create ${libname}_ixlibrary.a entries in /sys/libs. finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`$ECHO "X$lib" | $Xsed -e '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' ! ;; ! esac ;; beos*) *************** bsdi[45]*) *** 12756,12769 **** # libtool to hard-code these into programs ;; ! cygwin* | mingw* | pw32*) version_type=windows shrext_cmds=".dll" need_version=no need_lib_prefix=no ! case $withGCC,$host_os in ! yes,cygwin* | yes,mingw* | yes,pw32*) library_names_spec='$libname.dll.a' # DLL is installed to $(libdir)/../bin by postinstall_cmds postinstall_cmds='base_file=`basename \${file}`~ --- 13528,13541 ---- # libtool to hard-code these into programs ;; ! cygwin* | mingw* | pw32* | cegcc*) version_type=windows shrext_cmds=".dll" need_version=no need_lib_prefix=no ! case $GCC,$host_os in ! yes,cygwin* | yes,mingw* | yes,pw32* | yes,cegcc*) library_names_spec='$libname.dll.a' # DLL is installed to $(libdir)/../bin by postinstall_cmds postinstall_cmds='base_file=`basename \${file}`~ *************** cygwin* | mingw* | pw32*) *** 12786,12792 **** soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' sys_lib_search_path_spec="/usr/lib /lib/w32api /lib /usr/local/lib" ;; ! mingw*) # MinGW DLLs use traditional 'lib' prefix soname_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' sys_lib_search_path_spec=`$CC -print-search-dirs | $GREP "^libraries:" | $SED -e "s/^libraries://" -e "s,=/,/,g"` --- 13558,13564 ---- soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' sys_lib_search_path_spec="/usr/lib /lib/w32api /lib /usr/local/lib" ;; ! mingw* | cegcc*) # MinGW DLLs use traditional 'lib' prefix soname_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' sys_lib_search_path_spec=`$CC -print-search-dirs | $GREP "^libraries:" | $SED -e "s/^libraries://" -e "s,=/,/,g"` *************** linux*oldld* | linux*aout* | linux*coff* *** 13000,13006 **** ;; # This must be Linux ELF. ! linux* | k*bsd*-gnu) version_type=linux need_lib_prefix=no need_version=no --- 13772,13778 ---- ;; # This must be Linux ELF. ! linux* | k*bsd*-gnu | kopensolaris*-gnu) version_type=linux need_lib_prefix=no need_version=no *************** linux* | k*bsd*-gnu) *** 13009,13020 **** finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no # Some binutils ld are patched to set DT_RUNPATH ! save_LDFLAGS=$LDFLAGS ! save_libdir=$libdir ! eval "libdir=/foo; wl=\"$lt_prog_compiler_wl_FC\"; \ ! LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec_FC\"" ! if test x$gcc_no_link = xyes; then { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} { (exit 1); exit 1; }; } --- 13781,13797 ---- finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no + # Some binutils ld are patched to set DT_RUNPATH ! if test "${lt_cv_shlibpath_overrides_runpath+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! lt_cv_shlibpath_overrides_runpath=no ! save_LDFLAGS=$LDFLAGS ! save_libdir=$libdir ! eval "libdir=/foo; wl=\"$lt_prog_compiler_wl_FC\"; \ ! LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec_FC\"" ! if test x$gcc_no_link = xyes; then { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} { (exit 1); exit 1; }; } *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 13046,13053 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! if ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir"; then ! shlibpath_overrides_runpath=yes fi else --- 13823,13830 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! if ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then ! lt_cv_shlibpath_overrides_runpath=yes fi else *************** sed 's/^/| /' conftest.$ac_ext >&5 *** 13057,13064 **** fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext ! LDFLAGS=$save_LDFLAGS ! libdir=$save_libdir # This implies no fast_install, which is unacceptable. # Some rework will be needed to allow for fast_install --- 13834,13845 ---- fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext ! LDFLAGS=$save_LDFLAGS ! libdir=$save_libdir ! ! fi ! ! shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath # This implies no fast_install, which is unacceptable. # Some rework will be needed to allow for fast_install *************** rm -f conftest.err conftest.$ac_objext \ *** 13067,13073 **** # Append ld.so.conf contents to the search path if test -f /etc/ld.so.conf; then ! lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;/^$/d' | tr '\n' ' '` sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra" fi --- 13848,13854 ---- # Append ld.so.conf contents to the search path if test -f /etc/ld.so.conf; then ! lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;/^$/d' | tr '\n' ' '` sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra" fi *************** tpf*) *** 13251,13257 **** version_type=linux need_lib_prefix=no need_version=no ! library_name_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no hardcode_into_libs=yes --- 14032,14038 ---- version_type=linux need_lib_prefix=no need_version=no ! library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no hardcode_into_libs=yes *************** if test "$GCC" = yes; then *** 13277,13282 **** --- 14058,14070 ---- variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" fi + if test "${lt_cv_sys_lib_search_path_spec+set}" = set; then + sys_lib_search_path_spec="$lt_cv_sys_lib_search_path_spec" + fi + if test "${lt_cv_sys_lib_dlsearch_path_spec+set}" = set; then + sys_lib_dlsearch_path_spec="$lt_cv_sys_lib_dlsearch_path_spec" + fi + *************** fi *** 13358,13363 **** --- 14146,14152 ---- fi # test -n "$compiler" + GCC=$lt_save_GCC CC="$lt_save_CC" fi # test "$_lt_disable_FC" != yes *************** rm -f conftest.err conftest.$ac_objext c *** 15884,15902 **** done case $ac_lo in ?*) ac_cv_sizeof_void_p=$ac_lo;; ! '') { { echo "$as_me:$LINENO: error: cannot compute sizeof (void *), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (void *), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } ;; esac else if test "$cross_compiling" = yes; then ! { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ --- 16673,16695 ---- done case $ac_lo in ?*) ac_cv_sizeof_void_p=$ac_lo;; ! '') { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 ! echo "$as_me: error: in \`$ac_pwd':" >&2;} ! { { echo "$as_me:$LINENO: error: cannot compute sizeof (void *), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (void *), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } ;; esac else if test "$cross_compiling" = yes; then ! { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 ! echo "$as_me: error: in \`$ac_pwd':" >&2;} ! { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ *************** echo "$as_me: failed program was:" >&5 *** 15954,15964 **** sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute sizeof (void *), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (void *), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi --- 16747,16759 ---- sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) + { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 + echo "$as_me: error: in \`$ac_pwd':" >&2;} { { echo "$as_me:$LINENO: error: cannot compute sizeof (void *), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (void *), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi *************** rm -f conftest.err conftest.$ac_objext c *** 16302,16320 **** done case $ac_lo in ?*) ac_cv_sizeof_long=$ac_lo;; ! '') { { echo "$as_me:$LINENO: error: cannot compute sizeof (long), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (long), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } ;; esac else if test "$cross_compiling" = yes; then ! { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ --- 17097,17119 ---- done case $ac_lo in ?*) ac_cv_sizeof_long=$ac_lo;; ! '') { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 ! echo "$as_me: error: in \`$ac_pwd':" >&2;} ! { { echo "$as_me:$LINENO: error: cannot compute sizeof (long), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (long), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } ;; esac else if test "$cross_compiling" = yes; then ! { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 ! echo "$as_me: error: in \`$ac_pwd':" >&2;} ! { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ *************** echo "$as_me: failed program was:" >&5 *** 16372,16382 **** sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute sizeof (long), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (long), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi --- 17171,17183 ---- sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) + { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 + echo "$as_me: error: in \`$ac_pwd':" >&2;} { { echo "$as_me:$LINENO: error: cannot compute sizeof (long), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (long), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi *************** rm -f conftest.err conftest.$ac_objext c *** 16720,16738 **** done case $ac_lo in ?*) ac_cv_sizeof_int=$ac_lo;; ! '') { { echo "$as_me:$LINENO: error: cannot compute sizeof (int), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (int), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } ;; esac else if test "$cross_compiling" = yes; then ! { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ --- 17521,17543 ---- done case $ac_lo in ?*) ac_cv_sizeof_int=$ac_lo;; ! '') { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 ! echo "$as_me: error: in \`$ac_pwd':" >&2;} ! { { echo "$as_me:$LINENO: error: cannot compute sizeof (int), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (int), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } ;; esac else if test "$cross_compiling" = yes; then ! { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 ! echo "$as_me: error: in \`$ac_pwd':" >&2;} ! { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ *************** echo "$as_me: failed program was:" >&5 *** 16790,16800 **** sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute sizeof (int), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (int), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi --- 17595,17607 ---- sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) + { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 + echo "$as_me: error: in \`$ac_pwd':" >&2;} { { echo "$as_me:$LINENO: error: cannot compute sizeof (int), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (int), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi *************** rm -f conftest.err conftest.$ac_objext c *** 17134,17152 **** done case $ac_lo in ?*) ac_cv_sizeof_short=$ac_lo;; ! '') { { echo "$as_me:$LINENO: error: cannot compute sizeof (short), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (short), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } ;; esac else if test "$cross_compiling" = yes; then ! { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ --- 17941,17963 ---- done case $ac_lo in ?*) ac_cv_sizeof_short=$ac_lo;; ! '') { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 ! echo "$as_me: error: in \`$ac_pwd':" >&2;} ! { { echo "$as_me:$LINENO: error: cannot compute sizeof (short), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (short), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } ;; esac else if test "$cross_compiling" = yes; then ! { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 ! echo "$as_me: error: in \`$ac_pwd':" >&2;} ! { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ *************** echo "$as_me: failed program was:" >&5 *** 17204,17214 **** sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute sizeof (short), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (short), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi --- 18015,18027 ---- sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) + { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 + echo "$as_me: error: in \`$ac_pwd':" >&2;} { { echo "$as_me:$LINENO: error: cannot compute sizeof (short), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (short), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi *************** rm -f conftest.err conftest.$ac_objext c *** 17548,17566 **** done case $ac_lo in ?*) ac_cv_sizeof_char=$ac_lo;; ! '') { { echo "$as_me:$LINENO: error: cannot compute sizeof (char), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (char), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } ;; esac else if test "$cross_compiling" = yes; then ! { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ --- 18361,18383 ---- done case $ac_lo in ?*) ac_cv_sizeof_char=$ac_lo;; ! '') { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 ! echo "$as_me: error: in \`$ac_pwd':" >&2;} ! { { echo "$as_me:$LINENO: error: cannot compute sizeof (char), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (char), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } ;; esac else if test "$cross_compiling" = yes; then ! { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 ! echo "$as_me: error: in \`$ac_pwd':" >&2;} ! { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ *************** echo "$as_me: failed program was:" >&5 *** 17618,17628 **** sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute sizeof (char), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (char), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; } fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi --- 18435,18447 ---- sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) + { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 + echo "$as_me: error: in \`$ac_pwd':" >&2;} { { echo "$as_me:$LINENO: error: cannot compute sizeof (char), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (char), 77 See \`config.log' for more details." >&2;} ! { (exit 1); exit 1; }; }; } fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi *************** _ACEOF *** 18793,18798 **** --- 19612,19682 ---- fi + echo "$as_me:$LINENO: checking for uintptr_t" >&5 + echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6 + if test "${ac_cv_type_uintptr_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + if ((uintptr_t *) 0) + return 0; + if (sizeof (uintptr_t)) + return 0; + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_uintptr_t=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_type_uintptr_t=no + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5 + echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6 + if test $ac_cv_type_uintptr_t = yes; then + + cat >>confdefs.h <<_ACEOF + #define HAVE_UINTPTR_T 1 + _ACEOF + + + fi + # Check libc for getgid, getpid, getuid echo "$as_me:$LINENO: checking for getgid in -lc" >&5 *************** fi *** 31971,31977 **** echo "$as_me:$LINENO: checking whether isfinite is broken" >&5 echo $ECHO_N "checking whether isfinite is broken... $ECHO_C" >&6 ! if test "${have_broken_isfinite+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else --- 32855,32861 ---- echo "$as_me:$LINENO: checking whether isfinite is broken" >&5 echo $ECHO_N "checking whether isfinite is broken... $ECHO_C" >&6 ! if test "${libgfor_cv_have_broken_isfinite+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else *************** else *** 31980,31987 **** if test "$cross_compiling" = yes; then case "${target}" in ! hppa*-*-hpux*) have_broken_isfinite=yes ;; ! *) have_broken_isfinite=no ;; esac else cat >conftest.$ac_ext <<_ACEOF --- 32864,32871 ---- if test "$cross_compiling" = yes; then case "${target}" in ! hppa*-*-hpux*) libgfor_cv_have_broken_isfinite=yes ;; ! *) libgfor_cv_have_broken_isfinite=no ;; esac else cat >conftest.$ac_ext <<_ACEOF *************** cat confdefs.h >>conftest.$ac_ext *** 31991,31999 **** cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ - #ifdef HAVE_MATH_H #include - #endif #include int main () { --- 32875,32881 ---- *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 32019,32040 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! have_broken_isfinite=no else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ! have_broken_isfinite=yes fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi LIBS=$libgfor_check_for_broken_isfinite_save_LIBS fi ! echo "$as_me:$LINENO: result: $have_broken_isfinite" >&5 ! echo "${ECHO_T}$have_broken_isfinite" >&6 ! if test x"$have_broken_isfinite" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_BROKEN_ISFINITE 1 --- 32901,32922 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! libgfor_cv_have_broken_isfinite=no else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ! libgfor_cv_have_broken_isfinite=yes fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi LIBS=$libgfor_check_for_broken_isfinite_save_LIBS fi ! echo "$as_me:$LINENO: result: $libgfor_cv_have_broken_isfinite" >&5 ! echo "${ECHO_T}$libgfor_cv_have_broken_isfinite" >&6 ! if test x"$libgfor_cv_have_broken_isfinite" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_BROKEN_ISFINITE 1 *************** fi *** 32046,32052 **** echo "$as_me:$LINENO: checking whether isnan is broken" >&5 echo $ECHO_N "checking whether isnan is broken... $ECHO_C" >&6 ! if test "${have_broken_isnan+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else --- 32928,32934 ---- echo "$as_me:$LINENO: checking whether isnan is broken" >&5 echo $ECHO_N "checking whether isnan is broken... $ECHO_C" >&6 ! if test "${libgfor_cv_have_broken_isnan+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else *************** else *** 32055,32062 **** if test "$cross_compiling" = yes; then case "${target}" in ! hppa*-*-hpux*) have_broken_isnan=yes ;; ! *) have_broken_isnan=no ;; esac else cat >conftest.$ac_ext <<_ACEOF --- 32937,32944 ---- if test "$cross_compiling" = yes; then case "${target}" in ! hppa*-*-hpux*) libgfor_cv_have_broken_isnan=yes ;; ! *) libgfor_cv_have_broken_isnan=no ;; esac else cat >conftest.$ac_ext <<_ACEOF *************** cat confdefs.h >>conftest.$ac_ext *** 32066,32074 **** cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ - #ifdef HAVE_MATH_H #include - #endif #include int main () { --- 32948,32954 ---- *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 32112,32133 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! have_broken_isnan=no else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ! have_broken_isnan=yes fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi LIBS=$libgfor_check_for_broken_isnan_save_LIBS fi ! echo "$as_me:$LINENO: result: $have_broken_isnan" >&5 ! echo "${ECHO_T}$have_broken_isnan" >&6 ! if test x"$have_broken_isnan" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_BROKEN_ISNAN 1 --- 32992,33013 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! libgfor_cv_have_broken_isnan=no else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ! libgfor_cv_have_broken_isnan=yes fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi LIBS=$libgfor_check_for_broken_isnan_save_LIBS fi ! echo "$as_me:$LINENO: result: $libgfor_cv_have_broken_isnan" >&5 ! echo "${ECHO_T}$libgfor_cv_have_broken_isnan" >&6 ! if test x"$libgfor_cv_have_broken_isnan" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_BROKEN_ISNAN 1 *************** fi *** 32139,32145 **** echo "$as_me:$LINENO: checking whether fpclassify is broken" >&5 echo $ECHO_N "checking whether fpclassify is broken... $ECHO_C" >&6 ! if test "${have_broken_fpclassify+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else --- 33019,33025 ---- echo "$as_me:$LINENO: checking whether fpclassify is broken" >&5 echo $ECHO_N "checking whether fpclassify is broken... $ECHO_C" >&6 ! if test "${libgfor_cv_have_broken_fpclassify+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else *************** else *** 32148,32155 **** if test "$cross_compiling" = yes; then case "${target}" in ! hppa*-*-hpux*) have_broken_fpclassify=yes ;; ! *) have_broken_fpclassify=no ;; esac else cat >conftest.$ac_ext <<_ACEOF --- 33028,33035 ---- if test "$cross_compiling" = yes; then case "${target}" in ! hppa*-*-hpux*) libgfor_cv_have_broken_fpclassify=yes ;; ! *) libgfor_cv_have_broken_fpclassify=no ;; esac else cat >conftest.$ac_ext <<_ACEOF *************** cat confdefs.h >>conftest.$ac_ext *** 32159,32167 **** cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ - #ifdef HAVE_MATH_H #include - #endif #include int main () { --- 33039,33045 ---- *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 32189,32210 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! have_broken_fpclassify=no else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ! have_broken_fpclassify=yes fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi LIBS=$libgfor_check_for_broken_fpclassify_save_LIBS fi ! echo "$as_me:$LINENO: result: $have_broken_fpclassify" >&5 ! echo "${ECHO_T}$have_broken_fpclassify" >&6 ! if test x"$have_broken_fpclassify" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_BROKEN_FPCLASSIFY 1 --- 33067,33088 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! libgfor_cv_have_broken_fpclassify=no else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ! libgfor_cv_have_broken_fpclassify=yes fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi LIBS=$libgfor_check_for_broken_fpclassify_save_LIBS fi ! echo "$as_me:$LINENO: result: $libgfor_cv_have_broken_fpclassify" >&5 ! echo "${ECHO_T}$libgfor_cv_have_broken_fpclassify" >&6 ! if test x"$libgfor_cv_have_broken_fpclassify" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_BROKEN_FPCLASSIFY 1 *************** fi *** 32216,32230 **** echo "$as_me:$LINENO: checking whether the target stat is reliable" >&5 echo $ECHO_N "checking whether the target stat is reliable... $ECHO_C" >&6 ! if test "${have_working_stat+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "${target}" in ! *mingw*) have_working_stat=no ;; ! *) have_working_stat=yes;; esac else cat >conftest.$ac_ext <<_ACEOF --- 33094,33108 ---- echo "$as_me:$LINENO: checking whether the target stat is reliable" >&5 echo $ECHO_N "checking whether the target stat is reliable... $ECHO_C" >&6 ! if test "${libgfor_cv_have_working_stat+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "${target}" in ! *mingw*) libgfor_cv_have_working_stat=no ;; ! *) libgfor_cv_have_working_stat=yes;; esac else cat >conftest.$ac_ext <<_ACEOF *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 32266,32286 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! have_working_stat=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ! have_working_stat=no fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi ! echo "$as_me:$LINENO: result: $have_working_stat" >&5 ! echo "${ECHO_T}$have_working_stat" >&6 ! if test x"$have_working_stat" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_WORKING_STAT 1 --- 33144,33164 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! libgfor_cv_have_working_stat=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ! libgfor_cv_have_working_stat=no fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi ! echo "$as_me:$LINENO: result: $libgfor_cv_have_working_stat" >&5 ! echo "${ECHO_T}$libgfor_cv_have_working_stat" >&6 ! if test x"$libgfor_cv_have_working_stat" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_WORKING_STAT 1 *************** fi *** 32292,32298 **** echo "$as_me:$LINENO: checking whether __mingw_snprintf is present" >&5 echo $ECHO_N "checking whether __mingw_snprintf is present... $ECHO_C" >&6 ! if test "${have_mingw_snprintf+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else --- 33170,33176 ---- echo "$as_me:$LINENO: checking whether __mingw_snprintf is present" >&5 echo $ECHO_N "checking whether __mingw_snprintf is present... $ECHO_C" >&6 ! if test "${libgfor_cv_have_mingw_snprintf+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 32343,32362 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! eval "have_mingw_snprintf=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! eval "have_mingw_snprintf=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi ! echo "$as_me:$LINENO: result: $have_mingw_snprintf" >&5 ! echo "${ECHO_T}$have_mingw_snprintf" >&6 ! if test x"$have_mingw_snprintf" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_MINGW_SNPRINTF 1 --- 33221,33240 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! eval "libgfor_cv_have_mingw_snprintf=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! eval "libgfor_cv_have_mingw_snprintf=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi ! echo "$as_me:$LINENO: result: $libgfor_cv_have_mingw_snprintf" >&5 ! echo "${ECHO_T}$libgfor_cv_have_mingw_snprintf" >&6 ! if test x"$libgfor_cv_have_mingw_snprintf" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_MINGW_SNPRINTF 1 *************** fi *** 32472,32478 **** echo "$as_me:$LINENO: checking whether fpsetmask is present" >&5 echo $ECHO_N "checking whether fpsetmask is present... $ECHO_C" >&6 ! if test "${have_fpsetmask+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else --- 33350,33356 ---- echo "$as_me:$LINENO: checking whether fpsetmask is present" >&5 echo $ECHO_N "checking whether fpsetmask is present... $ECHO_C" >&6 ! if test "${libgfor_cv_have_fpsetmask+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 32524,32543 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! eval "have_fpsetmask=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! eval "have_fpsetmask=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi ! echo "$as_me:$LINENO: result: $have_fpsetmask" >&5 ! echo "${ECHO_T}$have_fpsetmask" >&6 ! if test x"$have_fpsetmask" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_FPSETMASK 1 --- 33402,33421 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! eval "libgfor_cv_have_fpsetmask=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! eval "libgfor_cv_have_fpsetmask=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi ! echo "$as_me:$LINENO: result: $libgfor_cv_have_fpsetmask" >&5 ! echo "${ECHO_T}$libgfor_cv_have_fpsetmask" >&6 ! if test x"$libgfor_cv_have_fpsetmask" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_FPSETMASK 1 *************** FPU_HOST_HEADER=config/${fpu_host}.h *** 32767,32773 **** echo "$as_me:$LINENO: checking whether the target supports hidden visibility" >&5 echo $ECHO_N "checking whether the target supports hidden visibility... $ECHO_C" >&6 ! if test "${have_attribute_visibility+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else --- 33645,33651 ---- echo "$as_me:$LINENO: checking whether the target supports hidden visibility" >&5 echo $ECHO_N "checking whether the target supports hidden visibility... $ECHO_C" >&6 ! if test "${libgfor_cv_have_attribute_visibility+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 32810,32828 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! have_attribute_visibility=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! have_attribute_visibility=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext CFLAGS="$save_CFLAGS" fi ! echo "$as_me:$LINENO: result: $have_attribute_visibility" >&5 ! echo "${ECHO_T}$have_attribute_visibility" >&6 ! if test $have_attribute_visibility = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_ATTRIBUTE_VISIBILITY 1 --- 33688,33706 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! libgfor_cv_have_attribute_visibility=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! libgfor_cv_have_attribute_visibility=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext CFLAGS="$save_CFLAGS" fi ! echo "$as_me:$LINENO: result: $libgfor_cv_have_attribute_visibility" >&5 ! echo "${ECHO_T}$libgfor_cv_have_attribute_visibility" >&6 ! if test $libgfor_cv_have_attribute_visibility = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_ATTRIBUTE_VISIBILITY 1 *************** _ACEOF *** 32832,32838 **** echo "$as_me:$LINENO: checking whether the target supports dllexport" >&5 echo $ECHO_N "checking whether the target supports dllexport... $ECHO_C" >&6 ! if test "${have_attribute_dllexport+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else --- 33710,33716 ---- echo "$as_me:$LINENO: checking whether the target supports dllexport" >&5 echo $ECHO_N "checking whether the target supports dllexport... $ECHO_C" >&6 ! if test "${libgfor_cv_have_attribute_dllexport+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 32875,32893 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! have_attribute_dllexport=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! have_attribute_dllexport=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext CFLAGS="$save_CFLAGS" fi ! echo "$as_me:$LINENO: result: $have_attribute_dllexport" >&5 ! echo "${ECHO_T}$have_attribute_dllexport" >&6 ! if test $have_attribute_dllexport = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_ATTRIBUTE_DLLEXPORT 1 --- 33753,33771 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! libgfor_cv_have_attribute_dllexport=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! libgfor_cv_have_attribute_dllexport=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext CFLAGS="$save_CFLAGS" fi ! echo "$as_me:$LINENO: result: $libgfor_cv_have_attribute_dllexport" >&5 ! echo "${ECHO_T}$libgfor_cv_have_attribute_dllexport" >&6 ! if test $libgfor_cv_have_attribute_dllexport = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_ATTRIBUTE_DLLEXPORT 1 *************** _ACEOF *** 32897,32903 **** echo "$as_me:$LINENO: checking whether the target supports symbol aliases" >&5 echo $ECHO_N "checking whether the target supports symbol aliases... $ECHO_C" >&6 ! if test "${have_attribute_alias+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else --- 33775,33781 ---- echo "$as_me:$LINENO: checking whether the target supports symbol aliases" >&5 echo $ECHO_N "checking whether the target supports symbol aliases... $ECHO_C" >&6 ! if test "${libgfor_cv_have_attribute_alias+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 32945,32963 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! have_attribute_alias=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! have_attribute_alias=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi ! echo "$as_me:$LINENO: result: $have_attribute_alias" >&5 ! echo "${ECHO_T}$have_attribute_alias" >&6 ! if test $have_attribute_alias = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_ATTRIBUTE_ALIAS 1 --- 33823,33841 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! libgfor_cv_have_attribute_alias=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! libgfor_cv_have_attribute_alias=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi ! echo "$as_me:$LINENO: result: $libgfor_cv_have_attribute_alias" >&5 ! echo "${ECHO_T}$libgfor_cv_have_attribute_alias" >&6 ! if test $libgfor_cv_have_attribute_alias = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_ATTRIBUTE_ALIAS 1 *************** _ACEOF *** 32969,32975 **** echo "$as_me:$LINENO: checking whether the target supports __sync_fetch_and_add" >&5 echo $ECHO_N "checking whether the target supports __sync_fetch_and_add... $ECHO_C" >&6 ! if test "${have_sync_fetch_and_add+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else --- 33847,33853 ---- echo "$as_me:$LINENO: checking whether the target supports __sync_fetch_and_add" >&5 echo $ECHO_N "checking whether the target supports __sync_fetch_and_add... $ECHO_C" >&6 ! if test "${libgfor_cv_have_sync_fetch_and_add+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 33017,33035 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! have_sync_fetch_and_add=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! have_sync_fetch_and_add=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi ! echo "$as_me:$LINENO: result: $have_sync_fetch_and_add" >&5 ! echo "${ECHO_T}$have_sync_fetch_and_add" >&6 ! if test $have_sync_fetch_and_add = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_SYNC_FETCH_AND_ADD 1 --- 33895,33913 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! libgfor_cv_have_sync_fetch_and_add=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! libgfor_cv_have_sync_fetch_and_add=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi ! echo "$as_me:$LINENO: result: $libgfor_cv_have_sync_fetch_and_add" >&5 ! echo "${ECHO_T}$libgfor_cv_have_sync_fetch_and_add" >&6 ! if test $libgfor_cv_have_sync_fetch_and_add = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_SYNC_FETCH_AND_ADD 1 *************** _ACEOF *** 33041,33056 **** echo "$as_me:$LINENO: checking configured target thread model" >&5 echo $ECHO_N "checking configured target thread model... $ECHO_C" >&6 ! if test "${target_thread_file+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ! target_thread_file=`$CC -v 2>&1 | sed -n 's/^Thread model: //p'` fi ! echo "$as_me:$LINENO: result: $target_thread_file" >&5 ! echo "${ECHO_T}$target_thread_file" >&6 ! if test $target_thread_file != single; then cat >>confdefs.h <<\_ACEOF #define HAVE_GTHR_DEFAULT 1 --- 33919,33934 ---- echo "$as_me:$LINENO: checking configured target thread model" >&5 echo $ECHO_N "checking configured target thread model... $ECHO_C" >&6 ! if test "${libgfor_cv_target_thread_file+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ! libgfor_cv_target_thread_file=`$CC -v 2>&1 | sed -n 's/^Thread model: //p'` fi ! echo "$as_me:$LINENO: result: $libgfor_cv_target_thread_file" >&5 ! echo "${ECHO_T}$libgfor_cv_target_thread_file" >&6 ! if test $libgfor_cv_target_thread_file != single; then cat >>confdefs.h <<\_ACEOF #define HAVE_GTHR_DEFAULT 1 *************** _ACEOF *** 33062,33068 **** echo "$as_me:$LINENO: checking whether pragma weak works" >&5 echo $ECHO_N "checking whether pragma weak works... $ECHO_C" >&6 ! if test "${have_pragma_weak+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else --- 33940,33946 ---- echo "$as_me:$LINENO: checking whether pragma weak works" >&5 echo $ECHO_N "checking whether pragma weak works... $ECHO_C" >&6 ! if test "${libgfor_cv_have_pragma_weak+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 33106,33123 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! have_pragma_weak=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! have_pragma_weak=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi ! echo "$as_me:$LINENO: result: $have_pragma_weak" >&5 ! echo "${ECHO_T}$have_pragma_weak" >&6 ! if test $have_pragma_weak = yes; then cat >>confdefs.h <<\_ACEOF #define SUPPORTS_WEAK 1 --- 33984,34001 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! libgfor_cv_have_pragma_weak=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! libgfor_cv_have_pragma_weak=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi ! echo "$as_me:$LINENO: result: $libgfor_cv_have_pragma_weak" >&5 ! echo "${ECHO_T}$libgfor_cv_have_pragma_weak" >&6 ! if test $libgfor_cv_have_pragma_weak = yes; then cat >>confdefs.h <<\_ACEOF #define SUPPORTS_WEAK 1 *************** _ACEOF *** 33138,33152 **** echo "$as_me:$LINENO: checking whether the target can unlink an open file" >&5 echo $ECHO_N "checking whether the target can unlink an open file... $ECHO_C" >&6 ! if test "${have_unlink_open_file+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "${target}" in ! *mingw*) have_unlink_open_file=no ;; ! *) have_unlink_open_file=yes;; esac else cat >conftest.$ac_ext <<_ACEOF --- 34016,34030 ---- echo "$as_me:$LINENO: checking whether the target can unlink an open file" >&5 echo $ECHO_N "checking whether the target can unlink an open file... $ECHO_C" >&6 ! if test "${libgfor_cv_have_unlink_open_file+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "${target}" in ! *mingw*) libgfor_cv_have_unlink_open_file=no ;; ! *) libgfor_cv_have_unlink_open_file=yes;; esac else cat >conftest.$ac_ext <<_ACEOF *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 33190,33210 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! have_unlink_open_file=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ! have_unlink_open_file=no fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi ! echo "$as_me:$LINENO: result: $have_unlink_open_file" >&5 ! echo "${ECHO_T}$have_unlink_open_file" >&6 ! if test x"$have_unlink_open_file" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_UNLINK_OPEN_FILE 1 --- 34068,34088 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! libgfor_cv_have_unlink_open_file=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ! libgfor_cv_have_unlink_open_file=no fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi ! echo "$as_me:$LINENO: result: $libgfor_cv_have_unlink_open_file" >&5 ! echo "${ECHO_T}$libgfor_cv_have_unlink_open_file" >&6 ! if test x"$libgfor_cv_have_unlink_open_file" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_UNLINK_OPEN_FILE 1 *************** fi *** 33216,33230 **** echo "$as_me:$LINENO: checking whether the target has CRLF as line terminator" >&5 echo $ECHO_N "checking whether the target has CRLF as line terminator... $ECHO_C" >&6 ! if test "${have_crlf+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "${target}" in ! *mingw*) have_crlf=yes ;; ! *) have_crlf=no;; esac else cat >conftest.$ac_ext <<_ACEOF --- 34094,34108 ---- echo "$as_me:$LINENO: checking whether the target has CRLF as line terminator" >&5 echo $ECHO_N "checking whether the target has CRLF as line terminator... $ECHO_C" >&6 ! if test "${libgfor_cv_have_crlf+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "${target}" in ! *mingw*) libgfor_cv_have_crlf=yes ;; ! *) libgfor_cv_have_crlf=no;; esac else cat >conftest.$ac_ext <<_ACEOF *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 33280,33300 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! have_crlf=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ! have_crlf=no fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi ! echo "$as_me:$LINENO: result: $have_crlf" >&5 ! echo "${ECHO_T}$have_crlf" >&6 ! if test x"$have_crlf" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_CRLF 1 --- 34158,34178 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! libgfor_cv_have_crlf=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ! libgfor_cv_have_crlf=no fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi ! echo "$as_me:$LINENO: result: $libgfor_cv_have_crlf" >&5 ! echo "${ECHO_T}$libgfor_cv_have_crlf" >&6 ! if test x"$libgfor_cv_have_crlf" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_CRLF 1 *************** lt_SP2NL='`$ECHO "X$lt_SP2NL" | $Xsed -e *** 33974,33979 **** --- 34852,34858 ---- lt_NL2SP='`$ECHO "X$lt_NL2SP" | $Xsed -e "$delay_single_quote_subst"`' reload_flag='`$ECHO "X$reload_flag" | $Xsed -e "$delay_single_quote_subst"`' reload_cmds='`$ECHO "X$reload_cmds" | $Xsed -e "$delay_single_quote_subst"`' + OBJDUMP='`$ECHO "X$OBJDUMP" | $Xsed -e "$delay_single_quote_subst"`' deplibs_check_method='`$ECHO "X$deplibs_check_method" | $Xsed -e "$delay_single_quote_subst"`' file_magic_cmd='`$ECHO "X$file_magic_cmd" | $Xsed -e "$delay_single_quote_subst"`' AR='`$ECHO "X$AR" | $Xsed -e "$delay_single_quote_subst"`' *************** GCC='`$ECHO "X$GCC" | $Xsed -e "$delay_s *** 33990,33995 **** --- 34869,34875 ---- lt_cv_sys_global_symbol_pipe='`$ECHO "X$lt_cv_sys_global_symbol_pipe" | $Xsed -e "$delay_single_quote_subst"`' lt_cv_sys_global_symbol_to_cdecl='`$ECHO "X$lt_cv_sys_global_symbol_to_cdecl" | $Xsed -e "$delay_single_quote_subst"`' lt_cv_sys_global_symbol_to_c_name_address='`$ECHO "X$lt_cv_sys_global_symbol_to_c_name_address" | $Xsed -e "$delay_single_quote_subst"`' + lt_cv_sys_global_symbol_to_c_name_address_lib_prefix='`$ECHO "X$lt_cv_sys_global_symbol_to_c_name_address_lib_prefix" | $Xsed -e "$delay_single_quote_subst"`' objdir='`$ECHO "X$objdir" | $Xsed -e "$delay_single_quote_subst"`' SHELL='`$ECHO "X$SHELL" | $Xsed -e "$delay_single_quote_subst"`' ECHO='`$ECHO "X$ECHO" | $Xsed -e "$delay_single_quote_subst"`' *************** lt_prog_compiler_pic='`$ECHO "X$lt_prog_ *** 34000,34005 **** --- 34880,34890 ---- lt_prog_compiler_static='`$ECHO "X$lt_prog_compiler_static" | $Xsed -e "$delay_single_quote_subst"`' lt_cv_prog_compiler_c_o='`$ECHO "X$lt_cv_prog_compiler_c_o" | $Xsed -e "$delay_single_quote_subst"`' need_locks='`$ECHO "X$need_locks" | $Xsed -e "$delay_single_quote_subst"`' + DSYMUTIL='`$ECHO "X$DSYMUTIL" | $Xsed -e "$delay_single_quote_subst"`' + NMEDIT='`$ECHO "X$NMEDIT" | $Xsed -e "$delay_single_quote_subst"`' + LIPO='`$ECHO "X$LIPO" | $Xsed -e "$delay_single_quote_subst"`' + OTOOL='`$ECHO "X$OTOOL" | $Xsed -e "$delay_single_quote_subst"`' + OTOOL64='`$ECHO "X$OTOOL64" | $Xsed -e "$delay_single_quote_subst"`' libext='`$ECHO "X$libext" | $Xsed -e "$delay_single_quote_subst"`' shrext_cmds='`$ECHO "X$shrext_cmds" | $Xsed -e "$delay_single_quote_subst"`' extract_expsyms_cmds='`$ECHO "X$extract_expsyms_cmds" | $Xsed -e "$delay_single_quote_subst"`' *************** enable_dlopen_self='`$ECHO "X$enable_dlo *** 34057,34062 **** --- 34942,34948 ---- enable_dlopen_self_static='`$ECHO "X$enable_dlopen_self_static" | $Xsed -e "$delay_single_quote_subst"`' old_striplib='`$ECHO "X$old_striplib" | $Xsed -e "$delay_single_quote_subst"`' striplib='`$ECHO "X$striplib" | $Xsed -e "$delay_single_quote_subst"`' + compiler_lib_search_dirs='`$ECHO "X$compiler_lib_search_dirs" | $Xsed -e "$delay_single_quote_subst"`' predep_objects='`$ECHO "X$predep_objects" | $Xsed -e "$delay_single_quote_subst"`' postdep_objects='`$ECHO "X$postdep_objects" | $Xsed -e "$delay_single_quote_subst"`' predeps='`$ECHO "X$predeps" | $Xsed -e "$delay_single_quote_subst"`' *************** include_expsyms_FC='`$ECHO "X$include_ex *** 34103,34108 **** --- 34989,34995 ---- prelink_cmds_FC='`$ECHO "X$prelink_cmds_FC" | $Xsed -e "$delay_single_quote_subst"`' file_list_spec_FC='`$ECHO "X$file_list_spec_FC" | $Xsed -e "$delay_single_quote_subst"`' hardcode_action_FC='`$ECHO "X$hardcode_action_FC" | $Xsed -e "$delay_single_quote_subst"`' + compiler_lib_search_dirs_FC='`$ECHO "X$compiler_lib_search_dirs_FC" | $Xsed -e "$delay_single_quote_subst"`' predep_objects_FC='`$ECHO "X$predep_objects_FC" | $Xsed -e "$delay_single_quote_subst"`' postdep_objects_FC='`$ECHO "X$postdep_objects_FC" | $Xsed -e "$delay_single_quote_subst"`' predeps_FC='`$ECHO "X$predeps_FC" | $Xsed -e "$delay_single_quote_subst"`' *************** LN_S \ *** 34124,34129 **** --- 35011,35017 ---- lt_SP2NL \ lt_NL2SP \ reload_flag \ + OBJDUMP \ deplibs_check_method \ file_magic_cmd \ AR \ *************** compiler \ *** 34136,34141 **** --- 35024,35030 ---- lt_cv_sys_global_symbol_pipe \ lt_cv_sys_global_symbol_to_cdecl \ lt_cv_sys_global_symbol_to_c_name_address \ + lt_cv_sys_global_symbol_to_c_name_address_lib_prefix \ SHELL \ ECHO \ lt_prog_compiler_no_builtin_flag \ *************** lt_prog_compiler_pic \ *** 34144,34149 **** --- 35033,35043 ---- lt_prog_compiler_static \ lt_cv_prog_compiler_c_o \ need_locks \ + DSYMUTIL \ + NMEDIT \ + LIPO \ + OTOOL \ + OTOOL64 \ shrext_cmds \ export_dynamic_flag_spec \ whole_archive_flag_spec \ *************** soname_spec \ *** 34165,34170 **** --- 35059,35065 ---- finish_eval \ old_striplib \ striplib \ + compiler_lib_search_dirs \ predep_objects \ postdep_objects \ predeps \ *************** fix_srcfile_path_FC \ *** 34190,34195 **** --- 35085,35091 ---- exclude_expsyms_FC \ include_expsyms_FC \ file_list_spec_FC \ + compiler_lib_search_dirs_FC \ predep_objects_FC \ postdep_objects_FC \ predeps_FC \ *************** s,@DUMPBIN@,$DUMPBIN,;t t *** 34470,34476 **** --- 35366,35384 ---- s,@ac_ct_DUMPBIN@,$ac_ct_DUMPBIN,;t t s,@NM@,$NM,;t t s,@LN_S@,$LN_S,;t t + s,@OBJDUMP@,$OBJDUMP,;t t + s,@ac_ct_OBJDUMP@,$ac_ct_OBJDUMP,;t t s,@lt_ECHO@,$lt_ECHO,;t t + s,@DSYMUTIL@,$DSYMUTIL,;t t + s,@ac_ct_DSYMUTIL@,$ac_ct_DSYMUTIL,;t t + s,@NMEDIT@,$NMEDIT,;t t + s,@ac_ct_NMEDIT@,$ac_ct_NMEDIT,;t t + s,@LIPO@,$LIPO,;t t + s,@ac_ct_LIPO@,$ac_ct_LIPO,;t t + s,@OTOOL@,$OTOOL,;t t + s,@ac_ct_OTOOL@,$ac_ct_OTOOL,;t t + s,@OTOOL64@,$OTOOL64,;t t + s,@ac_ct_OTOOL64@,$ac_ct_OTOOL64,;t t s,@CPP@,$CPP,;t t s,@CPPFLAGS@,$CPPFLAGS,;t t s,@enable_shared@,$enable_shared,;t t *************** done *** 35189,35224 **** #! $SHELL # `$ECHO "$ofile" | sed 's%^.*/%%'` - Provide generalized library-building support services. ! # Generated automatically by $as_me (GNU $PACKAGE$TIMESTAMP) $VERSION # Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`: # NOTE: Changes made to this file will be lost: look at ltmain.sh. # ! # Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2005, ! # 2006, 2007 Free Software Foundation, Inc. # ! # This file is part of GNU Libtool: ! # Originally by Gordon Matzigkeit , 1996 # ! # This program is free software; you can redistribute it and/or modify ! # it under the terms of the GNU General Public License as published by ! # the Free Software Foundation; either version 2 of the License, or ! # (at your option) any later version. # ! # This program is distributed in the hope that it will be useful, but ! # WITHOUT ANY WARRANTY; without even the implied warranty of ! # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ! # General Public License for more details. # ! # You should have received a copy of the GNU General Public License ! # along with this program; if not, a copy can be downloaded from ! # http://www.gnu.org/copyleft/gpl.html, or by writing to the Free ! # Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, ! # MA 02110-1301, USA. # ! # As a special exception to the GNU General Public License, if you ! # distribute this file as part of a program that contains a ! # configuration script generated by Autoconf, you may include it under ! # the same distribution terms that you use for the rest of that program. # The names of the tagged configurations supported by this script. --- 36097,36132 ---- #! $SHELL # `$ECHO "$ofile" | sed 's%^.*/%%'` - Provide generalized library-building support services. ! # Generated automatically by $as_me ($PACKAGE$TIMESTAMP) $VERSION # Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`: # NOTE: Changes made to this file will be lost: look at ltmain.sh. # ! # Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2005, ! # 2006, 2007, 2008 Free Software Foundation, Inc. ! # Written by Gordon Matzigkeit, 1996 # ! # This file is part of GNU Libtool. # ! # GNU Libtool is free software; you can redistribute it and/or ! # modify it under the terms of the GNU General Public License as ! # published by the Free Software Foundation; either version 2 of ! # the License, or (at your option) any later version. # ! # As a special exception to the GNU General Public License, ! # if you distribute this file as part of a program or library that ! # is built using GNU Libtool, you may include this file under the ! # same distribution terms that you use for the rest of that program. # ! # GNU Libtool is distributed in the hope that it will be useful, ! # but WITHOUT ANY WARRANTY; without even the implied warranty of ! # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! # GNU General Public License for more details. # ! # You should have received a copy of the GNU General Public License ! # along with GNU Libtool; see the file COPYING. If not, a copy ! # can be downloaded from http://www.gnu.org/licenses/gpl.html, or ! # obtained by writing to the Free Software Foundation, Inc., ! # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. # The names of the tagged configurations supported by this script. *************** NL2SP=$lt_lt_NL2SP *** 35295,35300 **** --- 36203,36211 ---- reload_flag=$lt_reload_flag reload_cmds=$lt_reload_cmds + # An object symbol dumper. + OBJDUMP=$lt_OBJDUMP + # Method to check whether dependent libraries are shared objects. deplibs_check_method=$lt_deplibs_check_method *************** global_symbol_to_cdecl=$lt_lt_cv_sys_glo *** 35328,35333 **** --- 36239,36247 ---- # Transform the output of nm in a C name address pair. global_symbol_to_c_name_address=$lt_lt_cv_sys_global_symbol_to_c_name_address + # Transform the output of nm in a C name address pair when lib prefix is needed. + global_symbol_to_c_name_address_lib_prefix=$lt_lt_cv_sys_global_symbol_to_c_name_address_lib_prefix + # The name of the directory that contains temporary libtool files. objdir=$objdir *************** MAGIC_CMD=$MAGIC_CMD *** 35343,35348 **** --- 36257,36277 ---- # Must we lock files when doing compilation? need_locks=$lt_need_locks + # Tool to manipulate archived DWARF debug symbol files on Mac OS X. + DSYMUTIL=$lt_DSYMUTIL + + # Tool to change global to local symbols on Mac OS X. + NMEDIT=$lt_NMEDIT + + # Tool to manipulate fat objects and archives on Mac OS X. + LIPO=$lt_LIPO + + # ldd/readelf like tool for Mach-O binaries on Mac OS X. + OTOOL=$lt_OTOOL + + # ldd/readelf like tool for 64 bit Mach-O binaries on Mac OS X 10.4. + OTOOL64=$lt_OTOOL64 + # Old archive suffix (normally "a"). libext=$libext *************** file_list_spec=$lt_file_list_spec *** 35551,35556 **** --- 36480,36488 ---- # How to hardcode a shared library path into an executable. hardcode_action=$hardcode_action + # The directories searched by this compiler when creating a shared library. + compiler_lib_search_dirs=$lt_compiler_lib_search_dirs + # Dependencies to place before and after the objects being linked to # create a shared library. predep_objects=$lt_predep_objects *************** ltmain="$ac_aux_dir/ltmain.sh" *** 35594,35599 **** --- 36526,36532 ---- case $xsi_shell in yes) cat << \_LT_EOF >> "$cfgfile" + # func_dirname file append nondir_replacement # Compute the dirname of FILE. If nonempty, add APPEND to the result, # otherwise set result to NONDIR_REPLACEMENT. *************** func_basename () *** 35611,35616 **** --- 36544,36570 ---- func_basename_result="${1##*/}" } + # func_dirname_and_basename file append nondir_replacement + # perform func_basename and func_dirname in a single function + # call: + # dirname: Compute the dirname of FILE. If nonempty, + # add APPEND to the result, otherwise set result + # to NONDIR_REPLACEMENT. + # value returned in "$func_dirname_result" + # basename: Compute filename of FILE. + # value retuned in "$func_basename_result" + # Implementation must be kept synchronized with func_dirname + # and func_basename. For efficiency, we do not delegate to + # those functions but instead duplicate the functionality here. + func_dirname_and_basename () + { + case ${1} in + */*) func_dirname_result="${1%/*}${2}" ;; + * ) func_dirname_result="${3}" ;; + esac + func_basename_result="${1##*/}" + } + # func_stripname prefix suffix name # strip PREFIX and SUFFIX off of NAME. # PREFIX and SUFFIX must not contain globbing or regex special *************** func_lo2o () *** 35640,35649 **** --- 36594,36624 ---- *) func_lo2o_result=${1} ;; esac } + + # func_xform libobj-or-source + func_xform () + { + func_xform_result=${1%.*}.lo + } + + # func_arith arithmetic-term... + func_arith () + { + func_arith_result=$(( $* )) + } + + # func_len string + # STRING may not start with a hyphen. + func_len () + { + func_len_result=${#1} + } + _LT_EOF ;; *) # Bourne compatible functions. cat << \_LT_EOF >> "$cfgfile" + # func_dirname file append nondir_replacement # Compute the dirname of FILE. If nonempty, add APPEND to the result, # otherwise set result to NONDIR_REPLACEMENT. *************** func_basename () *** 35664,35669 **** --- 36639,36645 ---- func_basename_result=`$ECHO "X${1}" | $Xsed -e "$basename"` } + # func_stripname prefix suffix name # strip PREFIX and SUFFIX off of NAME. # PREFIX and SUFFIX must not contain globbing or regex special *************** func_lo2o () *** 35696,35701 **** --- 36672,36697 ---- { func_lo2o_result=`$ECHO "X${1}" | $Xsed -e "$lo2o"` } + + # func_xform libobj-or-source + func_xform () + { + func_xform_result=`$ECHO "X${1}" | $Xsed -e 's/\.[^.]*$/.lo/'` + } + + # func_arith arithmetic-term... + func_arith () + { + func_arith_result=`expr "$@"` + } + + # func_len string + # STRING may not start with a hyphen. + func_len () + { + func_len_result=`expr "$1" : ".*" 2>/dev/null || echo $max_cmd_len` + } + _LT_EOF esac *************** func_append () *** 35720,35725 **** --- 36716,36722 ---- { eval "$1=\$$1\$2" } + _LT_EOF ;; esac *************** file_list_spec=$lt_file_list_spec_FC *** 35868,35873 **** --- 36865,36873 ---- # How to hardcode a shared library path into an executable. hardcode_action=$hardcode_action_FC + # The directories searched by this compiler when creating a shared library. + compiler_lib_search_dirs=$lt_compiler_lib_search_dirs_FC + # Dependencies to place before and after the objects being linked to # create a shared library. predep_objects=$lt_predep_objects_FC diff -Nrcpad gcc-4.3.3/libgfortran/configure.ac gcc-4.4.0/libgfortran/configure.ac *** gcc-4.3.3/libgfortran/configure.ac Wed Dec 31 15:42:12 2008 --- gcc-4.4.0/libgfortran/configure.ac Mon Dec 29 20:10:00 2008 *************** m4_rename([real_PRECIOUS],[_AC_ARG_VAR_P *** 123,129 **** # Add -Wall -fno-repack-arrays -fno-underscoring if we are using GCC. if test "x$GCC" = "xyes"; then ! AM_FCFLAGS="-I . -Wall -fno-repack-arrays -fno-underscoring" ## We like to use C99 routines when available. This makes sure that ## __STDC_VERSION__ is set such that libc includes make them available. AM_CFLAGS="-std=gnu99 -Wall -Wstrict-prototypes -Wmissing-prototypes -Wold-style-definition -Wextra -Wwrite-strings" --- 123,129 ---- # Add -Wall -fno-repack-arrays -fno-underscoring if we are using GCC. if test "x$GCC" = "xyes"; then ! AM_FCFLAGS="-I . -Wall -Werror -fimplicit-none -fno-repack-arrays -fno-underscoring" ## We like to use C99 routines when available. This makes sure that ## __STDC_VERSION__ is set such that libc includes make them available. AM_CFLAGS="-std=gnu99 -Wall -Wstrict-prototypes -Wmissing-prototypes -Wold-style-definition -Wextra -Wwrite-strings" *************** AC_CHECK_FUNCS(backtrace backtrace_symbo *** 211,216 **** --- 211,217 ---- # Check for types AC_CHECK_TYPES([intptr_t]) + AC_CHECK_TYPES([uintptr_t]) # Check libc for getgid, getpid, getuid AC_CHECK_LIB([c],[getgid],[AC_DEFINE([HAVE_GETGID],[1],[libc includes getgid])]) diff -Nrcpad gcc-4.3.3/libgfortran/generated/_abs_c10.F90 gcc-4.4.0/libgfortran/generated/_abs_c10.F90 *** gcc-4.3.3/libgfortran/generated/_abs_c10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_abs_c10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_abs_c16.F90 gcc-4.4.0/libgfortran/generated/_abs_c16.F90 *** gcc-4.3.3/libgfortran/generated/_abs_c16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_abs_c16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_abs_c4.F90 gcc-4.4.0/libgfortran/generated/_abs_c4.F90 *** gcc-4.3.3/libgfortran/generated/_abs_c4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_abs_c4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_abs_c8.F90 gcc-4.4.0/libgfortran/generated/_abs_c8.F90 *** gcc-4.3.3/libgfortran/generated/_abs_c8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_abs_c8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_abs_i16.F90 gcc-4.4.0/libgfortran/generated/_abs_i16.F90 *** gcc-4.3.3/libgfortran/generated/_abs_i16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_abs_i16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_abs_i4.F90 gcc-4.4.0/libgfortran/generated/_abs_i4.F90 *** gcc-4.3.3/libgfortran/generated/_abs_i4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_abs_i4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_abs_i8.F90 gcc-4.4.0/libgfortran/generated/_abs_i8.F90 *** gcc-4.3.3/libgfortran/generated/_abs_i8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_abs_i8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_abs_r10.F90 gcc-4.4.0/libgfortran/generated/_abs_r10.F90 *** gcc-4.3.3/libgfortran/generated/_abs_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_abs_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_abs_r16.F90 gcc-4.4.0/libgfortran/generated/_abs_r16.F90 *** gcc-4.3.3/libgfortran/generated/_abs_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_abs_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_abs_r4.F90 gcc-4.4.0/libgfortran/generated/_abs_r4.F90 *** gcc-4.3.3/libgfortran/generated/_abs_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_abs_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_abs_r8.F90 gcc-4.4.0/libgfortran/generated/_abs_r8.F90 *** gcc-4.3.3/libgfortran/generated/_abs_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_abs_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_acos_r10.F90 gcc-4.4.0/libgfortran/generated/_acos_r10.F90 *** gcc-4.3.3/libgfortran/generated/_acos_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_acos_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_acos_r16.F90 gcc-4.4.0/libgfortran/generated/_acos_r16.F90 *** gcc-4.3.3/libgfortran/generated/_acos_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_acos_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_acos_r4.F90 gcc-4.4.0/libgfortran/generated/_acos_r4.F90 *** gcc-4.3.3/libgfortran/generated/_acos_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_acos_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_acos_r8.F90 gcc-4.4.0/libgfortran/generated/_acos_r8.F90 *** gcc-4.3.3/libgfortran/generated/_acos_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_acos_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_acosh_r10.F90 gcc-4.4.0/libgfortran/generated/_acosh_r10.F90 *** gcc-4.3.3/libgfortran/generated/_acosh_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_acosh_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_acosh_r16.F90 gcc-4.4.0/libgfortran/generated/_acosh_r16.F90 *** gcc-4.3.3/libgfortran/generated/_acosh_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_acosh_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_acosh_r4.F90 gcc-4.4.0/libgfortran/generated/_acosh_r4.F90 *** gcc-4.3.3/libgfortran/generated/_acosh_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_acosh_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_acosh_r8.F90 gcc-4.4.0/libgfortran/generated/_acosh_r8.F90 *** gcc-4.3.3/libgfortran/generated/_acosh_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_acosh_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_aimag_c10.F90 gcc-4.4.0/libgfortran/generated/_aimag_c10.F90 *** gcc-4.3.3/libgfortran/generated/_aimag_c10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_aimag_c10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_aimag_c16.F90 gcc-4.4.0/libgfortran/generated/_aimag_c16.F90 *** gcc-4.3.3/libgfortran/generated/_aimag_c16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_aimag_c16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_aimag_c4.F90 gcc-4.4.0/libgfortran/generated/_aimag_c4.F90 *** gcc-4.3.3/libgfortran/generated/_aimag_c4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_aimag_c4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_aimag_c8.F90 gcc-4.4.0/libgfortran/generated/_aimag_c8.F90 *** gcc-4.3.3/libgfortran/generated/_aimag_c8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_aimag_c8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_aint_r10.F90 gcc-4.4.0/libgfortran/generated/_aint_r10.F90 *** gcc-4.3.3/libgfortran/generated/_aint_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_aint_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_aint_r16.F90 gcc-4.4.0/libgfortran/generated/_aint_r16.F90 *** gcc-4.3.3/libgfortran/generated/_aint_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_aint_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_aint_r4.F90 gcc-4.4.0/libgfortran/generated/_aint_r4.F90 *** gcc-4.3.3/libgfortran/generated/_aint_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_aint_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_aint_r8.F90 gcc-4.4.0/libgfortran/generated/_aint_r8.F90 *** gcc-4.3.3/libgfortran/generated/_aint_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_aint_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_anint_r10.F90 gcc-4.4.0/libgfortran/generated/_anint_r10.F90 *** gcc-4.3.3/libgfortran/generated/_anint_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_anint_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_anint_r16.F90 gcc-4.4.0/libgfortran/generated/_anint_r16.F90 *** gcc-4.3.3/libgfortran/generated/_anint_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_anint_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_anint_r4.F90 gcc-4.4.0/libgfortran/generated/_anint_r4.F90 *** gcc-4.3.3/libgfortran/generated/_anint_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_anint_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_anint_r8.F90 gcc-4.4.0/libgfortran/generated/_anint_r8.F90 *** gcc-4.3.3/libgfortran/generated/_anint_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_anint_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_asin_r10.F90 gcc-4.4.0/libgfortran/generated/_asin_r10.F90 *** gcc-4.3.3/libgfortran/generated/_asin_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_asin_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_asin_r16.F90 gcc-4.4.0/libgfortran/generated/_asin_r16.F90 *** gcc-4.3.3/libgfortran/generated/_asin_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_asin_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_asin_r4.F90 gcc-4.4.0/libgfortran/generated/_asin_r4.F90 *** gcc-4.3.3/libgfortran/generated/_asin_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_asin_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_asin_r8.F90 gcc-4.4.0/libgfortran/generated/_asin_r8.F90 *** gcc-4.3.3/libgfortran/generated/_asin_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_asin_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_asinh_r10.F90 gcc-4.4.0/libgfortran/generated/_asinh_r10.F90 *** gcc-4.3.3/libgfortran/generated/_asinh_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_asinh_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_asinh_r16.F90 gcc-4.4.0/libgfortran/generated/_asinh_r16.F90 *** gcc-4.3.3/libgfortran/generated/_asinh_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_asinh_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_asinh_r4.F90 gcc-4.4.0/libgfortran/generated/_asinh_r4.F90 *** gcc-4.3.3/libgfortran/generated/_asinh_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_asinh_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_asinh_r8.F90 gcc-4.4.0/libgfortran/generated/_asinh_r8.F90 *** gcc-4.3.3/libgfortran/generated/_asinh_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_asinh_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_atan2_r10.F90 gcc-4.4.0/libgfortran/generated/_atan2_r10.F90 *** gcc-4.3.3/libgfortran/generated/_atan2_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_atan2_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_atan2_r16.F90 gcc-4.4.0/libgfortran/generated/_atan2_r16.F90 *** gcc-4.3.3/libgfortran/generated/_atan2_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_atan2_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_atan2_r4.F90 gcc-4.4.0/libgfortran/generated/_atan2_r4.F90 *** gcc-4.3.3/libgfortran/generated/_atan2_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_atan2_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_atan2_r8.F90 gcc-4.4.0/libgfortran/generated/_atan2_r8.F90 *** gcc-4.3.3/libgfortran/generated/_atan2_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_atan2_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_atan_r10.F90 gcc-4.4.0/libgfortran/generated/_atan_r10.F90 *** gcc-4.3.3/libgfortran/generated/_atan_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_atan_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_atan_r16.F90 gcc-4.4.0/libgfortran/generated/_atan_r16.F90 *** gcc-4.3.3/libgfortran/generated/_atan_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_atan_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_atan_r4.F90 gcc-4.4.0/libgfortran/generated/_atan_r4.F90 *** gcc-4.3.3/libgfortran/generated/_atan_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_atan_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_atan_r8.F90 gcc-4.4.0/libgfortran/generated/_atan_r8.F90 *** gcc-4.3.3/libgfortran/generated/_atan_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_atan_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_atanh_r10.F90 gcc-4.4.0/libgfortran/generated/_atanh_r10.F90 *** gcc-4.3.3/libgfortran/generated/_atanh_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_atanh_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_atanh_r16.F90 gcc-4.4.0/libgfortran/generated/_atanh_r16.F90 *** gcc-4.3.3/libgfortran/generated/_atanh_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_atanh_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_atanh_r4.F90 gcc-4.4.0/libgfortran/generated/_atanh_r4.F90 *** gcc-4.3.3/libgfortran/generated/_atanh_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_atanh_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_atanh_r8.F90 gcc-4.4.0/libgfortran/generated/_atanh_r8.F90 *** gcc-4.3.3/libgfortran/generated/_atanh_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_atanh_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_conjg_c10.F90 gcc-4.4.0/libgfortran/generated/_conjg_c10.F90 *** gcc-4.3.3/libgfortran/generated/_conjg_c10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_conjg_c10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_conjg_c16.F90 gcc-4.4.0/libgfortran/generated/_conjg_c16.F90 *** gcc-4.3.3/libgfortran/generated/_conjg_c16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_conjg_c16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_conjg_c4.F90 gcc-4.4.0/libgfortran/generated/_conjg_c4.F90 *** gcc-4.3.3/libgfortran/generated/_conjg_c4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_conjg_c4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_conjg_c8.F90 gcc-4.4.0/libgfortran/generated/_conjg_c8.F90 *** gcc-4.3.3/libgfortran/generated/_conjg_c8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_conjg_c8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_cos_c10.F90 gcc-4.4.0/libgfortran/generated/_cos_c10.F90 *** gcc-4.3.3/libgfortran/generated/_cos_c10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_cos_c10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_cos_c16.F90 gcc-4.4.0/libgfortran/generated/_cos_c16.F90 *** gcc-4.3.3/libgfortran/generated/_cos_c16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_cos_c16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_cos_c4.F90 gcc-4.4.0/libgfortran/generated/_cos_c4.F90 *** gcc-4.3.3/libgfortran/generated/_cos_c4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_cos_c4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_cos_c8.F90 gcc-4.4.0/libgfortran/generated/_cos_c8.F90 *** gcc-4.3.3/libgfortran/generated/_cos_c8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_cos_c8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_cos_r10.F90 gcc-4.4.0/libgfortran/generated/_cos_r10.F90 *** gcc-4.3.3/libgfortran/generated/_cos_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_cos_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_cos_r16.F90 gcc-4.4.0/libgfortran/generated/_cos_r16.F90 *** gcc-4.3.3/libgfortran/generated/_cos_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_cos_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_cos_r4.F90 gcc-4.4.0/libgfortran/generated/_cos_r4.F90 *** gcc-4.3.3/libgfortran/generated/_cos_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_cos_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_cos_r8.F90 gcc-4.4.0/libgfortran/generated/_cos_r8.F90 *** gcc-4.3.3/libgfortran/generated/_cos_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_cos_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_cosh_r10.F90 gcc-4.4.0/libgfortran/generated/_cosh_r10.F90 *** gcc-4.3.3/libgfortran/generated/_cosh_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_cosh_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_cosh_r16.F90 gcc-4.4.0/libgfortran/generated/_cosh_r16.F90 *** gcc-4.3.3/libgfortran/generated/_cosh_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_cosh_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_cosh_r4.F90 gcc-4.4.0/libgfortran/generated/_cosh_r4.F90 *** gcc-4.3.3/libgfortran/generated/_cosh_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_cosh_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_cosh_r8.F90 gcc-4.4.0/libgfortran/generated/_cosh_r8.F90 *** gcc-4.3.3/libgfortran/generated/_cosh_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_cosh_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_dim_i16.F90 gcc-4.4.0/libgfortran/generated/_dim_i16.F90 *** gcc-4.3.3/libgfortran/generated/_dim_i16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_dim_i16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_dim_i4.F90 gcc-4.4.0/libgfortran/generated/_dim_i4.F90 *** gcc-4.3.3/libgfortran/generated/_dim_i4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_dim_i4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_dim_i8.F90 gcc-4.4.0/libgfortran/generated/_dim_i8.F90 *** gcc-4.3.3/libgfortran/generated/_dim_i8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_dim_i8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_dim_r10.F90 gcc-4.4.0/libgfortran/generated/_dim_r10.F90 *** gcc-4.3.3/libgfortran/generated/_dim_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_dim_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_dim_r16.F90 gcc-4.4.0/libgfortran/generated/_dim_r16.F90 *** gcc-4.3.3/libgfortran/generated/_dim_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_dim_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_dim_r4.F90 gcc-4.4.0/libgfortran/generated/_dim_r4.F90 *** gcc-4.3.3/libgfortran/generated/_dim_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_dim_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_dim_r8.F90 gcc-4.4.0/libgfortran/generated/_dim_r8.F90 *** gcc-4.3.3/libgfortran/generated/_dim_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_dim_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_exp_c10.F90 gcc-4.4.0/libgfortran/generated/_exp_c10.F90 *** gcc-4.3.3/libgfortran/generated/_exp_c10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_exp_c10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_exp_c16.F90 gcc-4.4.0/libgfortran/generated/_exp_c16.F90 *** gcc-4.3.3/libgfortran/generated/_exp_c16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_exp_c16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_exp_c4.F90 gcc-4.4.0/libgfortran/generated/_exp_c4.F90 *** gcc-4.3.3/libgfortran/generated/_exp_c4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_exp_c4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_exp_c8.F90 gcc-4.4.0/libgfortran/generated/_exp_c8.F90 *** gcc-4.3.3/libgfortran/generated/_exp_c8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_exp_c8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_exp_r10.F90 gcc-4.4.0/libgfortran/generated/_exp_r10.F90 *** gcc-4.3.3/libgfortran/generated/_exp_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_exp_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_exp_r16.F90 gcc-4.4.0/libgfortran/generated/_exp_r16.F90 *** gcc-4.3.3/libgfortran/generated/_exp_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_exp_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_exp_r4.F90 gcc-4.4.0/libgfortran/generated/_exp_r4.F90 *** gcc-4.3.3/libgfortran/generated/_exp_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_exp_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_exp_r8.F90 gcc-4.4.0/libgfortran/generated/_exp_r8.F90 *** gcc-4.3.3/libgfortran/generated/_exp_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_exp_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_log10_r10.F90 gcc-4.4.0/libgfortran/generated/_log10_r10.F90 *** gcc-4.3.3/libgfortran/generated/_log10_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_log10_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_log10_r16.F90 gcc-4.4.0/libgfortran/generated/_log10_r16.F90 *** gcc-4.3.3/libgfortran/generated/_log10_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_log10_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_log10_r4.F90 gcc-4.4.0/libgfortran/generated/_log10_r4.F90 *** gcc-4.3.3/libgfortran/generated/_log10_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_log10_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_log10_r8.F90 gcc-4.4.0/libgfortran/generated/_log10_r8.F90 *** gcc-4.3.3/libgfortran/generated/_log10_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_log10_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_log_c10.F90 gcc-4.4.0/libgfortran/generated/_log_c10.F90 *** gcc-4.3.3/libgfortran/generated/_log_c10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_log_c10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_log_c16.F90 gcc-4.4.0/libgfortran/generated/_log_c16.F90 *** gcc-4.3.3/libgfortran/generated/_log_c16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_log_c16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_log_c4.F90 gcc-4.4.0/libgfortran/generated/_log_c4.F90 *** gcc-4.3.3/libgfortran/generated/_log_c4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_log_c4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_log_c8.F90 gcc-4.4.0/libgfortran/generated/_log_c8.F90 *** gcc-4.3.3/libgfortran/generated/_log_c8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_log_c8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_log_r10.F90 gcc-4.4.0/libgfortran/generated/_log_r10.F90 *** gcc-4.3.3/libgfortran/generated/_log_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_log_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_log_r16.F90 gcc-4.4.0/libgfortran/generated/_log_r16.F90 *** gcc-4.3.3/libgfortran/generated/_log_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_log_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_log_r4.F90 gcc-4.4.0/libgfortran/generated/_log_r4.F90 *** gcc-4.3.3/libgfortran/generated/_log_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_log_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_log_r8.F90 gcc-4.4.0/libgfortran/generated/_log_r8.F90 *** gcc-4.3.3/libgfortran/generated/_log_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_log_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_mod_i16.F90 gcc-4.4.0/libgfortran/generated/_mod_i16.F90 *** gcc-4.3.3/libgfortran/generated/_mod_i16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_mod_i16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_mod_i4.F90 gcc-4.4.0/libgfortran/generated/_mod_i4.F90 *** gcc-4.3.3/libgfortran/generated/_mod_i4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_mod_i4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_mod_i8.F90 gcc-4.4.0/libgfortran/generated/_mod_i8.F90 *** gcc-4.3.3/libgfortran/generated/_mod_i8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_mod_i8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_mod_r10.F90 gcc-4.4.0/libgfortran/generated/_mod_r10.F90 *** gcc-4.3.3/libgfortran/generated/_mod_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_mod_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_mod_r16.F90 gcc-4.4.0/libgfortran/generated/_mod_r16.F90 *** gcc-4.3.3/libgfortran/generated/_mod_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_mod_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_mod_r4.F90 gcc-4.4.0/libgfortran/generated/_mod_r4.F90 *** gcc-4.3.3/libgfortran/generated/_mod_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_mod_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_mod_r8.F90 gcc-4.4.0/libgfortran/generated/_mod_r8.F90 *** gcc-4.3.3/libgfortran/generated/_mod_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_mod_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sign_i16.F90 gcc-4.4.0/libgfortran/generated/_sign_i16.F90 *** gcc-4.3.3/libgfortran/generated/_sign_i16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sign_i16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sign_i4.F90 gcc-4.4.0/libgfortran/generated/_sign_i4.F90 *** gcc-4.3.3/libgfortran/generated/_sign_i4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sign_i4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sign_i8.F90 gcc-4.4.0/libgfortran/generated/_sign_i8.F90 *** gcc-4.3.3/libgfortran/generated/_sign_i8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sign_i8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sign_r10.F90 gcc-4.4.0/libgfortran/generated/_sign_r10.F90 *** gcc-4.3.3/libgfortran/generated/_sign_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sign_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sign_r16.F90 gcc-4.4.0/libgfortran/generated/_sign_r16.F90 *** gcc-4.3.3/libgfortran/generated/_sign_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sign_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sign_r4.F90 gcc-4.4.0/libgfortran/generated/_sign_r4.F90 *** gcc-4.3.3/libgfortran/generated/_sign_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sign_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sign_r8.F90 gcc-4.4.0/libgfortran/generated/_sign_r8.F90 *** gcc-4.3.3/libgfortran/generated/_sign_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sign_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sin_c10.F90 gcc-4.4.0/libgfortran/generated/_sin_c10.F90 *** gcc-4.3.3/libgfortran/generated/_sin_c10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sin_c10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sin_c16.F90 gcc-4.4.0/libgfortran/generated/_sin_c16.F90 *** gcc-4.3.3/libgfortran/generated/_sin_c16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sin_c16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sin_c4.F90 gcc-4.4.0/libgfortran/generated/_sin_c4.F90 *** gcc-4.3.3/libgfortran/generated/_sin_c4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sin_c4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sin_c8.F90 gcc-4.4.0/libgfortran/generated/_sin_c8.F90 *** gcc-4.3.3/libgfortran/generated/_sin_c8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sin_c8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sin_r10.F90 gcc-4.4.0/libgfortran/generated/_sin_r10.F90 *** gcc-4.3.3/libgfortran/generated/_sin_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sin_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sin_r16.F90 gcc-4.4.0/libgfortran/generated/_sin_r16.F90 *** gcc-4.3.3/libgfortran/generated/_sin_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sin_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sin_r4.F90 gcc-4.4.0/libgfortran/generated/_sin_r4.F90 *** gcc-4.3.3/libgfortran/generated/_sin_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sin_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sin_r8.F90 gcc-4.4.0/libgfortran/generated/_sin_r8.F90 *** gcc-4.3.3/libgfortran/generated/_sin_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sin_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sinh_r10.F90 gcc-4.4.0/libgfortran/generated/_sinh_r10.F90 *** gcc-4.3.3/libgfortran/generated/_sinh_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sinh_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sinh_r16.F90 gcc-4.4.0/libgfortran/generated/_sinh_r16.F90 *** gcc-4.3.3/libgfortran/generated/_sinh_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sinh_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sinh_r4.F90 gcc-4.4.0/libgfortran/generated/_sinh_r4.F90 *** gcc-4.3.3/libgfortran/generated/_sinh_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sinh_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sinh_r8.F90 gcc-4.4.0/libgfortran/generated/_sinh_r8.F90 *** gcc-4.3.3/libgfortran/generated/_sinh_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sinh_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sqrt_c10.F90 gcc-4.4.0/libgfortran/generated/_sqrt_c10.F90 *** gcc-4.3.3/libgfortran/generated/_sqrt_c10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sqrt_c10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sqrt_c16.F90 gcc-4.4.0/libgfortran/generated/_sqrt_c16.F90 *** gcc-4.3.3/libgfortran/generated/_sqrt_c16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sqrt_c16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sqrt_c4.F90 gcc-4.4.0/libgfortran/generated/_sqrt_c4.F90 *** gcc-4.3.3/libgfortran/generated/_sqrt_c4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sqrt_c4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sqrt_c8.F90 gcc-4.4.0/libgfortran/generated/_sqrt_c8.F90 *** gcc-4.3.3/libgfortran/generated/_sqrt_c8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sqrt_c8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sqrt_r10.F90 gcc-4.4.0/libgfortran/generated/_sqrt_r10.F90 *** gcc-4.3.3/libgfortran/generated/_sqrt_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sqrt_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sqrt_r16.F90 gcc-4.4.0/libgfortran/generated/_sqrt_r16.F90 *** gcc-4.3.3/libgfortran/generated/_sqrt_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sqrt_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sqrt_r4.F90 gcc-4.4.0/libgfortran/generated/_sqrt_r4.F90 *** gcc-4.3.3/libgfortran/generated/_sqrt_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sqrt_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_sqrt_r8.F90 gcc-4.4.0/libgfortran/generated/_sqrt_r8.F90 *** gcc-4.3.3/libgfortran/generated/_sqrt_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_sqrt_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_tan_r10.F90 gcc-4.4.0/libgfortran/generated/_tan_r10.F90 *** gcc-4.3.3/libgfortran/generated/_tan_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_tan_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_tan_r16.F90 gcc-4.4.0/libgfortran/generated/_tan_r16.F90 *** gcc-4.3.3/libgfortran/generated/_tan_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_tan_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_tan_r4.F90 gcc-4.4.0/libgfortran/generated/_tan_r4.F90 *** gcc-4.3.3/libgfortran/generated/_tan_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_tan_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_tan_r8.F90 gcc-4.4.0/libgfortran/generated/_tan_r8.F90 *** gcc-4.3.3/libgfortran/generated/_tan_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_tan_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_tanh_r10.F90 gcc-4.4.0/libgfortran/generated/_tanh_r10.F90 *** gcc-4.3.3/libgfortran/generated/_tanh_r10.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_tanh_r10.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_tanh_r16.F90 gcc-4.4.0/libgfortran/generated/_tanh_r16.F90 *** gcc-4.3.3/libgfortran/generated/_tanh_r16.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_tanh_r16.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_tanh_r4.F90 gcc-4.4.0/libgfortran/generated/_tanh_r4.F90 *** gcc-4.3.3/libgfortran/generated/_tanh_r4.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_tanh_r4.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/_tanh_r8.F90 gcc-4.4.0/libgfortran/generated/_tanh_r8.F90 *** gcc-4.3.3/libgfortran/generated/_tanh_r8.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/_tanh_r8.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/all_l1.c gcc-4.4.0/libgfortran/generated/all_l1.c *** gcc-4.3.3/libgfortran/generated/all_l1.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/all_l1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the ALL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the ALL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** all_l1 (gfc_array_l1 * const restrict re *** 123,132 **** { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ALL intrinsic: is %d, should be %d", ! GFC_DESCRIPTOR_RANK (retarray), rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,128 ---- { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ALL intrinsic: is %ld, should be %ld", ! (long int) GFC_DESCRIPTOR_RANK (retarray), ! (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** all_l1 (gfc_array_l1 * const restrict re *** 137,143 **** if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ALL intrinsic in dimension %d:" ! " is %ld, should be %ld", n + 1, (long int) ret_extent, (long int) extent[n]); } } --- 133,139 ---- if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ALL intrinsic in dimension %d:" ! " is %ld, should be %ld", (int) n + 1, (long int) ret_extent, (long int) extent[n]); } } diff -Nrcpad gcc-4.3.3/libgfortran/generated/all_l16.c gcc-4.4.0/libgfortran/generated/all_l16.c *** gcc-4.3.3/libgfortran/generated/all_l16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/all_l16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the ALL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the ALL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** all_l16 (gfc_array_l16 * const restrict *** 123,132 **** { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ALL intrinsic: is %d, should be %d", ! GFC_DESCRIPTOR_RANK (retarray), rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,128 ---- { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ALL intrinsic: is %ld, should be %ld", ! (long int) GFC_DESCRIPTOR_RANK (retarray), ! (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** all_l16 (gfc_array_l16 * const restrict *** 137,143 **** if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ALL intrinsic in dimension %d:" ! " is %ld, should be %ld", n + 1, (long int) ret_extent, (long int) extent[n]); } } --- 133,139 ---- if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ALL intrinsic in dimension %d:" ! " is %ld, should be %ld", (int) n + 1, (long int) ret_extent, (long int) extent[n]); } } diff -Nrcpad gcc-4.3.3/libgfortran/generated/all_l2.c gcc-4.4.0/libgfortran/generated/all_l2.c *** gcc-4.3.3/libgfortran/generated/all_l2.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/all_l2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the ALL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the ALL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** all_l2 (gfc_array_l2 * const restrict re *** 123,132 **** { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ALL intrinsic: is %d, should be %d", ! GFC_DESCRIPTOR_RANK (retarray), rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,128 ---- { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ALL intrinsic: is %ld, should be %ld", ! (long int) GFC_DESCRIPTOR_RANK (retarray), ! (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** all_l2 (gfc_array_l2 * const restrict re *** 137,143 **** if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ALL intrinsic in dimension %d:" ! " is %ld, should be %ld", n + 1, (long int) ret_extent, (long int) extent[n]); } } --- 133,139 ---- if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ALL intrinsic in dimension %d:" ! " is %ld, should be %ld", (int) n + 1, (long int) ret_extent, (long int) extent[n]); } } diff -Nrcpad gcc-4.3.3/libgfortran/generated/all_l4.c gcc-4.4.0/libgfortran/generated/all_l4.c *** gcc-4.3.3/libgfortran/generated/all_l4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/all_l4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the ALL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the ALL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** all_l4 (gfc_array_l4 * const restrict re *** 123,132 **** { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ALL intrinsic: is %d, should be %d", ! GFC_DESCRIPTOR_RANK (retarray), rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,128 ---- { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ALL intrinsic: is %ld, should be %ld", ! (long int) GFC_DESCRIPTOR_RANK (retarray), ! (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** all_l4 (gfc_array_l4 * const restrict re *** 137,143 **** if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ALL intrinsic in dimension %d:" ! " is %ld, should be %ld", n + 1, (long int) ret_extent, (long int) extent[n]); } } --- 133,139 ---- if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ALL intrinsic in dimension %d:" ! " is %ld, should be %ld", (int) n + 1, (long int) ret_extent, (long int) extent[n]); } } diff -Nrcpad gcc-4.3.3/libgfortran/generated/all_l8.c gcc-4.4.0/libgfortran/generated/all_l8.c *** gcc-4.3.3/libgfortran/generated/all_l8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/all_l8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the ALL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the ALL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** all_l8 (gfc_array_l8 * const restrict re *** 123,132 **** { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ALL intrinsic: is %d, should be %d", ! GFC_DESCRIPTOR_RANK (retarray), rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,128 ---- { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ALL intrinsic: is %ld, should be %ld", ! (long int) GFC_DESCRIPTOR_RANK (retarray), ! (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** all_l8 (gfc_array_l8 * const restrict re *** 137,143 **** if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ALL intrinsic in dimension %d:" ! " is %ld, should be %ld", n + 1, (long int) ret_extent, (long int) extent[n]); } } --- 133,139 ---- if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ALL intrinsic in dimension %d:" ! " is %ld, should be %ld", (int) n + 1, (long int) ret_extent, (long int) extent[n]); } } diff -Nrcpad gcc-4.3.3/libgfortran/generated/any_l1.c gcc-4.4.0/libgfortran/generated/any_l1.c *** gcc-4.3.3/libgfortran/generated/any_l1.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/any_l1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the ANY intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the ANY intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** any_l1 (gfc_array_l1 * const restrict re *** 123,132 **** { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ANY intrinsic: is %d, should be %d", ! GFC_DESCRIPTOR_RANK (retarray), rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,128 ---- { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ANY intrinsic: is %ld, should be %ld", ! (long int) GFC_DESCRIPTOR_RANK (retarray), ! (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** any_l1 (gfc_array_l1 * const restrict re *** 137,143 **** if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ANY intrinsic in dimension %d:" ! " is %ld, should be %ld", n + 1, (long int) ret_extent, (long int) extent[n]); } } --- 133,139 ---- if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ANY intrinsic in dimension %d:" ! " is %ld, should be %ld", (int) n + 1, (long int) ret_extent, (long int) extent[n]); } } diff -Nrcpad gcc-4.3.3/libgfortran/generated/any_l16.c gcc-4.4.0/libgfortran/generated/any_l16.c *** gcc-4.3.3/libgfortran/generated/any_l16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/any_l16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the ANY intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the ANY intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** any_l16 (gfc_array_l16 * const restrict *** 123,132 **** { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ANY intrinsic: is %d, should be %d", ! GFC_DESCRIPTOR_RANK (retarray), rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,128 ---- { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ANY intrinsic: is %ld, should be %ld", ! (long int) GFC_DESCRIPTOR_RANK (retarray), ! (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** any_l16 (gfc_array_l16 * const restrict *** 137,143 **** if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ANY intrinsic in dimension %d:" ! " is %ld, should be %ld", n + 1, (long int) ret_extent, (long int) extent[n]); } } --- 133,139 ---- if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ANY intrinsic in dimension %d:" ! " is %ld, should be %ld", (int) n + 1, (long int) ret_extent, (long int) extent[n]); } } diff -Nrcpad gcc-4.3.3/libgfortran/generated/any_l2.c gcc-4.4.0/libgfortran/generated/any_l2.c *** gcc-4.3.3/libgfortran/generated/any_l2.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/any_l2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the ANY intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the ANY intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** any_l2 (gfc_array_l2 * const restrict re *** 123,132 **** { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ANY intrinsic: is %d, should be %d", ! GFC_DESCRIPTOR_RANK (retarray), rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,128 ---- { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ANY intrinsic: is %ld, should be %ld", ! (long int) GFC_DESCRIPTOR_RANK (retarray), ! (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** any_l2 (gfc_array_l2 * const restrict re *** 137,143 **** if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ANY intrinsic in dimension %d:" ! " is %ld, should be %ld", n + 1, (long int) ret_extent, (long int) extent[n]); } } --- 133,139 ---- if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ANY intrinsic in dimension %d:" ! " is %ld, should be %ld", (int) n + 1, (long int) ret_extent, (long int) extent[n]); } } diff -Nrcpad gcc-4.3.3/libgfortran/generated/any_l4.c gcc-4.4.0/libgfortran/generated/any_l4.c *** gcc-4.3.3/libgfortran/generated/any_l4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/any_l4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the ANY intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the ANY intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** any_l4 (gfc_array_l4 * const restrict re *** 123,132 **** { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ANY intrinsic: is %d, should be %d", ! GFC_DESCRIPTOR_RANK (retarray), rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,128 ---- { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ANY intrinsic: is %ld, should be %ld", ! (long int) GFC_DESCRIPTOR_RANK (retarray), ! (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** any_l4 (gfc_array_l4 * const restrict re *** 137,143 **** if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ANY intrinsic in dimension %d:" ! " is %ld, should be %ld", n + 1, (long int) ret_extent, (long int) extent[n]); } } --- 133,139 ---- if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ANY intrinsic in dimension %d:" ! " is %ld, should be %ld", (int) n + 1, (long int) ret_extent, (long int) extent[n]); } } diff -Nrcpad gcc-4.3.3/libgfortran/generated/any_l8.c gcc-4.4.0/libgfortran/generated/any_l8.c *** gcc-4.3.3/libgfortran/generated/any_l8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/any_l8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the ANY intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the ANY intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** any_l8 (gfc_array_l8 * const restrict re *** 123,132 **** { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ANY intrinsic: is %d, should be %d", ! GFC_DESCRIPTOR_RANK (retarray), rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,128 ---- { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " ANY intrinsic: is %ld, should be %ld", ! (long int) GFC_DESCRIPTOR_RANK (retarray), ! (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** any_l8 (gfc_array_l8 * const restrict re *** 137,143 **** if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ANY intrinsic in dimension %d:" ! " is %ld, should be %ld", n + 1, (long int) ret_extent, (long int) extent[n]); } } --- 133,139 ---- if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ANY intrinsic in dimension %d:" ! " is %ld, should be %ld", (int) n + 1, (long int) ret_extent, (long int) extent[n]); } } diff -Nrcpad gcc-4.3.3/libgfortran/generated/count_16_l.c gcc-4.4.0/libgfortran/generated/count_16_l.c *** gcc-4.3.3/libgfortran/generated/count_16_l.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/count_16_l.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the COUNT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the COUNT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** count_16_l (gfc_array_i16 * const restri *** 123,132 **** { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " COUNT intrinsic: is %d, should be %d", ! GFC_DESCRIPTOR_RANK (retarray), rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,128 ---- { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " COUNT intrinsic: is %ld, should be %ld", ! (long int) GFC_DESCRIPTOR_RANK (retarray), ! (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** count_16_l (gfc_array_i16 * const restri *** 137,143 **** if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " COUNT intrinsic in dimension %d:" ! " is %ld, should be %ld", n + 1, (long int) ret_extent, (long int) extent[n]); } } --- 133,139 ---- if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " COUNT intrinsic in dimension %d:" ! " is %ld, should be %ld", (int) n + 1, (long int) ret_extent, (long int) extent[n]); } } diff -Nrcpad gcc-4.3.3/libgfortran/generated/count_1_l.c gcc-4.4.0/libgfortran/generated/count_1_l.c *** gcc-4.3.3/libgfortran/generated/count_1_l.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/count_1_l.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the COUNT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the COUNT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** count_1_l (gfc_array_i1 * const restrict *** 123,132 **** { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " COUNT intrinsic: is %d, should be %d", ! GFC_DESCRIPTOR_RANK (retarray), rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,128 ---- { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " COUNT intrinsic: is %ld, should be %ld", ! (long int) GFC_DESCRIPTOR_RANK (retarray), ! (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** count_1_l (gfc_array_i1 * const restrict *** 137,143 **** if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " COUNT intrinsic in dimension %d:" ! " is %ld, should be %ld", n + 1, (long int) ret_extent, (long int) extent[n]); } } --- 133,139 ---- if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " COUNT intrinsic in dimension %d:" ! " is %ld, should be %ld", (int) n + 1, (long int) ret_extent, (long int) extent[n]); } } diff -Nrcpad gcc-4.3.3/libgfortran/generated/count_2_l.c gcc-4.4.0/libgfortran/generated/count_2_l.c *** gcc-4.3.3/libgfortran/generated/count_2_l.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/count_2_l.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the COUNT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the COUNT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** count_2_l (gfc_array_i2 * const restrict *** 123,132 **** { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " COUNT intrinsic: is %d, should be %d", ! GFC_DESCRIPTOR_RANK (retarray), rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,128 ---- { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " COUNT intrinsic: is %ld, should be %ld", ! (long int) GFC_DESCRIPTOR_RANK (retarray), ! (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** count_2_l (gfc_array_i2 * const restrict *** 137,143 **** if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " COUNT intrinsic in dimension %d:" ! " is %ld, should be %ld", n + 1, (long int) ret_extent, (long int) extent[n]); } } --- 133,139 ---- if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " COUNT intrinsic in dimension %d:" ! " is %ld, should be %ld", (int) n + 1, (long int) ret_extent, (long int) extent[n]); } } diff -Nrcpad gcc-4.3.3/libgfortran/generated/count_4_l.c gcc-4.4.0/libgfortran/generated/count_4_l.c *** gcc-4.3.3/libgfortran/generated/count_4_l.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/count_4_l.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the COUNT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the COUNT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** count_4_l (gfc_array_i4 * const restrict *** 123,132 **** { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " COUNT intrinsic: is %d, should be %d", ! GFC_DESCRIPTOR_RANK (retarray), rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,128 ---- { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " COUNT intrinsic: is %ld, should be %ld", ! (long int) GFC_DESCRIPTOR_RANK (retarray), ! (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** count_4_l (gfc_array_i4 * const restrict *** 137,143 **** if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " COUNT intrinsic in dimension %d:" ! " is %ld, should be %ld", n + 1, (long int) ret_extent, (long int) extent[n]); } } --- 133,139 ---- if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " COUNT intrinsic in dimension %d:" ! " is %ld, should be %ld", (int) n + 1, (long int) ret_extent, (long int) extent[n]); } } diff -Nrcpad gcc-4.3.3/libgfortran/generated/count_8_l.c gcc-4.4.0/libgfortran/generated/count_8_l.c *** gcc-4.3.3/libgfortran/generated/count_8_l.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/count_8_l.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the COUNT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the COUNT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** count_8_l (gfc_array_i8 * const restrict *** 123,132 **** { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " COUNT intrinsic: is %d, should be %d", ! GFC_DESCRIPTOR_RANK (retarray), rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,128 ---- { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " COUNT intrinsic: is %ld, should be %ld", ! (long int) GFC_DESCRIPTOR_RANK (retarray), ! (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** count_8_l (gfc_array_i8 * const restrict *** 137,143 **** if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " COUNT intrinsic in dimension %d:" ! " is %ld, should be %ld", n + 1, (long int) ret_extent, (long int) extent[n]); } } --- 133,139 ---- if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " COUNT intrinsic in dimension %d:" ! " is %ld, should be %ld", (int) n + 1, (long int) ret_extent, (long int) extent[n]); } } diff -Nrcpad gcc-4.3.3/libgfortran/generated/cshift0_c10.c gcc-4.4.0/libgfortran/generated/cshift0_c10.c *** gcc-4.3.3/libgfortran/generated/cshift0_c10.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/cshift0_c10.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,171 ---- + /* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_COMPLEX_10) + + void + cshift0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, ssize_t shift, + int which) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_COMPLEX_10 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_COMPLEX_10 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride; + if (roffset == 0) + roffset = 1; + soffset = array->dim[dim].stride; + if (soffset == 0) + soffset = 1; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride; + sstride[n] = array->dim[dim].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_COMPLEX_10); + size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_10); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_COMPLEX_10 *dest = rptr; + const GFC_COMPLEX_10 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; + } + + #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/cshift0_c16.c gcc-4.4.0/libgfortran/generated/cshift0_c16.c *** gcc-4.3.3/libgfortran/generated/cshift0_c16.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/cshift0_c16.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,171 ---- + /* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_COMPLEX_16) + + void + cshift0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, ssize_t shift, + int which) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_COMPLEX_16 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_COMPLEX_16 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride; + if (roffset == 0) + roffset = 1; + soffset = array->dim[dim].stride; + if (soffset == 0) + soffset = 1; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride; + sstride[n] = array->dim[dim].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_COMPLEX_16); + size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_16); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_COMPLEX_16 *dest = rptr; + const GFC_COMPLEX_16 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; + } + + #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/cshift0_c4.c gcc-4.4.0/libgfortran/generated/cshift0_c4.c *** gcc-4.3.3/libgfortran/generated/cshift0_c4.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/cshift0_c4.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,171 ---- + /* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_COMPLEX_4) + + void + cshift0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, ssize_t shift, + int which) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_COMPLEX_4 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_COMPLEX_4 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride; + if (roffset == 0) + roffset = 1; + soffset = array->dim[dim].stride; + if (soffset == 0) + soffset = 1; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride; + sstride[n] = array->dim[dim].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_COMPLEX_4); + size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_4); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_COMPLEX_4 *dest = rptr; + const GFC_COMPLEX_4 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; + } + + #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/cshift0_c8.c gcc-4.4.0/libgfortran/generated/cshift0_c8.c *** gcc-4.3.3/libgfortran/generated/cshift0_c8.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/cshift0_c8.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,171 ---- + /* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_COMPLEX_8) + + void + cshift0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, ssize_t shift, + int which) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_COMPLEX_8 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_COMPLEX_8 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride; + if (roffset == 0) + roffset = 1; + soffset = array->dim[dim].stride; + if (soffset == 0) + soffset = 1; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride; + sstride[n] = array->dim[dim].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_COMPLEX_8); + size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_8); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_COMPLEX_8 *dest = rptr; + const GFC_COMPLEX_8 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; + } + + #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/cshift0_i1.c gcc-4.4.0/libgfortran/generated/cshift0_i1.c *** gcc-4.3.3/libgfortran/generated/cshift0_i1.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/cshift0_i1.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,171 ---- + /* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_1) + + void + cshift0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, ssize_t shift, + int which) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_INTEGER_1 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_INTEGER_1 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride; + if (roffset == 0) + roffset = 1; + soffset = array->dim[dim].stride; + if (soffset == 0) + soffset = 1; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride; + sstride[n] = array->dim[dim].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_INTEGER_1); + size_t len2 = (len - shift) * sizeof (GFC_INTEGER_1); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_INTEGER_1 *dest = rptr; + const GFC_INTEGER_1 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; + } + + #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/cshift0_i16.c gcc-4.4.0/libgfortran/generated/cshift0_i16.c *** gcc-4.3.3/libgfortran/generated/cshift0_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/cshift0_i16.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,171 ---- + /* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_16) + + void + cshift0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, ssize_t shift, + int which) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_INTEGER_16 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_INTEGER_16 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride; + if (roffset == 0) + roffset = 1; + soffset = array->dim[dim].stride; + if (soffset == 0) + soffset = 1; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride; + sstride[n] = array->dim[dim].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_INTEGER_16); + size_t len2 = (len - shift) * sizeof (GFC_INTEGER_16); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_INTEGER_16 *dest = rptr; + const GFC_INTEGER_16 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; + } + + #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/cshift0_i2.c gcc-4.4.0/libgfortran/generated/cshift0_i2.c *** gcc-4.3.3/libgfortran/generated/cshift0_i2.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/cshift0_i2.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,171 ---- + /* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_2) + + void + cshift0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, ssize_t shift, + int which) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_INTEGER_2 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_INTEGER_2 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride; + if (roffset == 0) + roffset = 1; + soffset = array->dim[dim].stride; + if (soffset == 0) + soffset = 1; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride; + sstride[n] = array->dim[dim].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_INTEGER_2); + size_t len2 = (len - shift) * sizeof (GFC_INTEGER_2); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_INTEGER_2 *dest = rptr; + const GFC_INTEGER_2 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; + } + + #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/cshift0_i4.c gcc-4.4.0/libgfortran/generated/cshift0_i4.c *** gcc-4.3.3/libgfortran/generated/cshift0_i4.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/cshift0_i4.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,171 ---- + /* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_4) + + void + cshift0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, ssize_t shift, + int which) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_INTEGER_4 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_INTEGER_4 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride; + if (roffset == 0) + roffset = 1; + soffset = array->dim[dim].stride; + if (soffset == 0) + soffset = 1; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride; + sstride[n] = array->dim[dim].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_INTEGER_4); + size_t len2 = (len - shift) * sizeof (GFC_INTEGER_4); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_INTEGER_4 *dest = rptr; + const GFC_INTEGER_4 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; + } + + #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/cshift0_i8.c gcc-4.4.0/libgfortran/generated/cshift0_i8.c *** gcc-4.3.3/libgfortran/generated/cshift0_i8.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/cshift0_i8.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,171 ---- + /* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_8) + + void + cshift0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, ssize_t shift, + int which) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_INTEGER_8 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_INTEGER_8 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride; + if (roffset == 0) + roffset = 1; + soffset = array->dim[dim].stride; + if (soffset == 0) + soffset = 1; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride; + sstride[n] = array->dim[dim].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_INTEGER_8); + size_t len2 = (len - shift) * sizeof (GFC_INTEGER_8); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_INTEGER_8 *dest = rptr; + const GFC_INTEGER_8 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; + } + + #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/cshift0_r10.c gcc-4.4.0/libgfortran/generated/cshift0_r10.c *** gcc-4.3.3/libgfortran/generated/cshift0_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/cshift0_r10.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,171 ---- + /* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_10) + + void + cshift0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, ssize_t shift, + int which) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_REAL_10 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_REAL_10 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride; + if (roffset == 0) + roffset = 1; + soffset = array->dim[dim].stride; + if (soffset == 0) + soffset = 1; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride; + sstride[n] = array->dim[dim].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_REAL_10); + size_t len2 = (len - shift) * sizeof (GFC_REAL_10); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_REAL_10 *dest = rptr; + const GFC_REAL_10 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; + } + + #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/cshift0_r16.c gcc-4.4.0/libgfortran/generated/cshift0_r16.c *** gcc-4.3.3/libgfortran/generated/cshift0_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/cshift0_r16.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,171 ---- + /* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_16) + + void + cshift0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, ssize_t shift, + int which) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_REAL_16 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_REAL_16 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride; + if (roffset == 0) + roffset = 1; + soffset = array->dim[dim].stride; + if (soffset == 0) + soffset = 1; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride; + sstride[n] = array->dim[dim].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_REAL_16); + size_t len2 = (len - shift) * sizeof (GFC_REAL_16); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_REAL_16 *dest = rptr; + const GFC_REAL_16 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; + } + + #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/cshift0_r4.c gcc-4.4.0/libgfortran/generated/cshift0_r4.c *** gcc-4.3.3/libgfortran/generated/cshift0_r4.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/cshift0_r4.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,171 ---- + /* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_4) + + void + cshift0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, ssize_t shift, + int which) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_REAL_4 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_REAL_4 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride; + if (roffset == 0) + roffset = 1; + soffset = array->dim[dim].stride; + if (soffset == 0) + soffset = 1; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride; + sstride[n] = array->dim[dim].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_REAL_4); + size_t len2 = (len - shift) * sizeof (GFC_REAL_4); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_REAL_4 *dest = rptr; + const GFC_REAL_4 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; + } + + #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/cshift0_r8.c gcc-4.4.0/libgfortran/generated/cshift0_r8.c *** gcc-4.3.3/libgfortran/generated/cshift0_r8.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/cshift0_r8.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,171 ---- + /* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_8) + + void + cshift0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, ssize_t shift, + int which) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_REAL_8 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_REAL_8 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride; + if (roffset == 0) + roffset = 1; + soffset = array->dim[dim].stride; + if (soffset == 0) + soffset = 1; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride; + sstride[n] = array->dim[dim].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_REAL_8); + size_t len2 = (len - shift) * sizeof (GFC_REAL_8); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_REAL_8 *dest = rptr; + const GFC_REAL_8 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; + } + + #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/cshift1_16.c gcc-4.4.0/libgfortran/generated/cshift1_16.c *** gcc-4.3.3/libgfortran/generated/cshift1_16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/cshift1_16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the CSHIFT intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Feng Wang This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the CSHIFT intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Feng Wang This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** cshift1 (gfc_array_char * const restrict *** 67,72 **** --- 62,68 ---- index_type n; int which; GFC_INTEGER_16 sh; + index_type arraysize; if (pwhich) which = *pwhich - 1; *************** cshift1 (gfc_array_char * const restrict *** 76,86 **** if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); if (ret->data == NULL) { int i; ! ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) --- 72,84 ---- if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); + arraysize = size0 ((array_t *)array); + if (ret->data == NULL) { int i; ! ret->data = internal_malloc_size (size * arraysize); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) *************** cshift1 (gfc_array_char * const restrict *** 95,100 **** --- 93,101 ---- } } + if (arraysize == 0) + return; + extent[0] = 1; count[0] = 0; n = 0; *************** cshift1_16 (gfc_array_char * const restr *** 212,217 **** --- 213,219 ---- cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array)); } + void cshift1_16_char (gfc_array_char * const restrict ret, GFC_INTEGER_4, const gfc_array_char * const restrict array, *************** cshift1_16_char (gfc_array_char * const *** 231,234 **** --- 233,256 ---- cshift1 (ret, array, h, pwhich, array_length); } + + void cshift1_16_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4, + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const GFC_INTEGER_16 * const restrict pwhich, + GFC_INTEGER_4); + export_proto(cshift1_16_char4); + + void + cshift1_16_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const GFC_INTEGER_16 * const restrict pwhich, + GFC_INTEGER_4 array_length) + { + cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t)); + } + #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/cshift1_4.c gcc-4.4.0/libgfortran/generated/cshift1_4.c *** gcc-4.3.3/libgfortran/generated/cshift1_4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/cshift1_4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the CSHIFT intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Feng Wang This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the CSHIFT intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Feng Wang This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** cshift1 (gfc_array_char * const restrict *** 67,72 **** --- 62,68 ---- index_type n; int which; GFC_INTEGER_4 sh; + index_type arraysize; if (pwhich) which = *pwhich - 1; *************** cshift1 (gfc_array_char * const restrict *** 76,86 **** if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); if (ret->data == NULL) { int i; ! ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) --- 72,84 ---- if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); + arraysize = size0 ((array_t *)array); + if (ret->data == NULL) { int i; ! ret->data = internal_malloc_size (size * arraysize); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) *************** cshift1 (gfc_array_char * const restrict *** 95,100 **** --- 93,101 ---- } } + if (arraysize == 0) + return; + extent[0] = 1; count[0] = 0; n = 0; *************** cshift1_4 (gfc_array_char * const restri *** 212,217 **** --- 213,219 ---- cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array)); } + void cshift1_4_char (gfc_array_char * const restrict ret, GFC_INTEGER_4, const gfc_array_char * const restrict array, *************** cshift1_4_char (gfc_array_char * const r *** 231,234 **** --- 233,256 ---- cshift1 (ret, array, h, pwhich, array_length); } + + void cshift1_4_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4, + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const GFC_INTEGER_4 * const restrict pwhich, + GFC_INTEGER_4); + export_proto(cshift1_4_char4); + + void + cshift1_4_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const GFC_INTEGER_4 * const restrict pwhich, + GFC_INTEGER_4 array_length) + { + cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t)); + } + #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/cshift1_8.c gcc-4.4.0/libgfortran/generated/cshift1_8.c *** gcc-4.3.3/libgfortran/generated/cshift1_8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/cshift1_8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the CSHIFT intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Feng Wang This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the CSHIFT intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Feng Wang This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** cshift1 (gfc_array_char * const restrict *** 67,72 **** --- 62,68 ---- index_type n; int which; GFC_INTEGER_8 sh; + index_type arraysize; if (pwhich) which = *pwhich - 1; *************** cshift1 (gfc_array_char * const restrict *** 76,86 **** if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); if (ret->data == NULL) { int i; ! ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) --- 72,84 ---- if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); + arraysize = size0 ((array_t *)array); + if (ret->data == NULL) { int i; ! ret->data = internal_malloc_size (size * arraysize); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) *************** cshift1 (gfc_array_char * const restrict *** 95,100 **** --- 93,101 ---- } } + if (arraysize == 0) + return; + extent[0] = 1; count[0] = 0; n = 0; *************** cshift1_8 (gfc_array_char * const restri *** 212,217 **** --- 213,219 ---- cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array)); } + void cshift1_8_char (gfc_array_char * const restrict ret, GFC_INTEGER_4, const gfc_array_char * const restrict array, *************** cshift1_8_char (gfc_array_char * const r *** 231,234 **** --- 233,256 ---- cshift1 (ret, array, h, pwhich, array_length); } + + void cshift1_8_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4, + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const GFC_INTEGER_8 * const restrict pwhich, + GFC_INTEGER_4); + export_proto(cshift1_8_char4); + + void + cshift1_8_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const GFC_INTEGER_8 * const restrict pwhich, + GFC_INTEGER_4 array_length) + { + cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t)); + } + #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/eoshift1_16.c gcc-4.4.0/libgfortran/generated/eoshift1_16.c *** gcc-4.3.3/libgfortran/generated/eoshift1_16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/eoshift1_16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** eoshift1 (gfc_array_char * const restric *** 42,55 **** const gfc_array_i16 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_16 * const restrict pwhich, ! index_type size, char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; char *rptr; ! char *dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; --- 37,50 ---- const gfc_array_i16 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_16 * const restrict pwhich, ! index_type size, const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; char *rptr; ! char * restrict dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; *************** eoshift1 (gfc_array_char * const restric *** 102,107 **** --- 97,107 ---- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; } } + else + { + if (size0 ((array_t *) ret) == 0) + return; + } n = 0; for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) *************** eoshift1 (gfc_array_char * const restric *** 183,189 **** else while (n--) { ! memset (dest, filler, size); dest += roffset; } --- 183,196 ---- else while (n--) { ! index_type i; ! ! if (filler_len == 1) ! memset (dest, filler[0], size); ! else ! for (i = 0; i < size; i += filler_len) ! memcpy (&dest[i], filler, filler_len); ! dest += roffset; } *************** eoshift1_16 (gfc_array_char * const rest *** 234,242 **** const char * const restrict pbound, const GFC_INTEGER_16 * const restrict pwhich) { ! eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); } void eoshift1_16_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, --- 241,251 ---- const char * const restrict pbound, const GFC_INTEGER_16 * const restrict pwhich) { ! eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), ! "\0", 1); } + void eoshift1_16_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, *************** eoshift1_16_char (gfc_array_char * const *** 256,262 **** GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { ! eoshift1 (ret, array, h, pbound, pwhich, array_length, ' '); } #endif --- 265,296 ---- GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { ! eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1); ! } ! ! ! void eoshift1_16_char4 (gfc_array_char * const restrict, ! GFC_INTEGER_4, ! const gfc_array_char * const restrict, ! const gfc_array_i16 * const restrict, ! const char * const restrict, ! const GFC_INTEGER_16 * const restrict, ! GFC_INTEGER_4, GFC_INTEGER_4); ! export_proto(eoshift1_16_char4); ! ! void ! eoshift1_16_char4 (gfc_array_char * const restrict ret, ! GFC_INTEGER_4 ret_length __attribute__((unused)), ! const gfc_array_char * const restrict array, ! const gfc_array_i16 * const restrict h, ! const char * const restrict pbound, ! const GFC_INTEGER_16 * const restrict pwhich, ! GFC_INTEGER_4 array_length, ! GFC_INTEGER_4 bound_length __attribute__((unused))) ! { ! static const gfc_char4_t space = (unsigned char) ' '; ! eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t), ! (const char *) &space, sizeof (gfc_char4_t)); } #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/eoshift1_4.c gcc-4.4.0/libgfortran/generated/eoshift1_4.c *** gcc-4.3.3/libgfortran/generated/eoshift1_4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/eoshift1_4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** eoshift1 (gfc_array_char * const restric *** 42,55 **** const gfc_array_i4 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_4 * const restrict pwhich, ! index_type size, char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; char *rptr; ! char *dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; --- 37,50 ---- const gfc_array_i4 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_4 * const restrict pwhich, ! index_type size, const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; char *rptr; ! char * restrict dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; *************** eoshift1 (gfc_array_char * const restric *** 102,107 **** --- 97,107 ---- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; } } + else + { + if (size0 ((array_t *) ret) == 0) + return; + } n = 0; for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) *************** eoshift1 (gfc_array_char * const restric *** 183,189 **** else while (n--) { ! memset (dest, filler, size); dest += roffset; } --- 183,196 ---- else while (n--) { ! index_type i; ! ! if (filler_len == 1) ! memset (dest, filler[0], size); ! else ! for (i = 0; i < size; i += filler_len) ! memcpy (&dest[i], filler, filler_len); ! dest += roffset; } *************** eoshift1_4 (gfc_array_char * const restr *** 234,242 **** const char * const restrict pbound, const GFC_INTEGER_4 * const restrict pwhich) { ! eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); } void eoshift1_4_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, --- 241,251 ---- const char * const restrict pbound, const GFC_INTEGER_4 * const restrict pwhich) { ! eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), ! "\0", 1); } + void eoshift1_4_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, *************** eoshift1_4_char (gfc_array_char * const *** 256,262 **** GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { ! eoshift1 (ret, array, h, pbound, pwhich, array_length, ' '); } #endif --- 265,296 ---- GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { ! eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1); ! } ! ! ! void eoshift1_4_char4 (gfc_array_char * const restrict, ! GFC_INTEGER_4, ! const gfc_array_char * const restrict, ! const gfc_array_i4 * const restrict, ! const char * const restrict, ! const GFC_INTEGER_4 * const restrict, ! GFC_INTEGER_4, GFC_INTEGER_4); ! export_proto(eoshift1_4_char4); ! ! void ! eoshift1_4_char4 (gfc_array_char * const restrict ret, ! GFC_INTEGER_4 ret_length __attribute__((unused)), ! const gfc_array_char * const restrict array, ! const gfc_array_i4 * const restrict h, ! const char * const restrict pbound, ! const GFC_INTEGER_4 * const restrict pwhich, ! GFC_INTEGER_4 array_length, ! GFC_INTEGER_4 bound_length __attribute__((unused))) ! { ! static const gfc_char4_t space = (unsigned char) ' '; ! eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t), ! (const char *) &space, sizeof (gfc_char4_t)); } #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/eoshift1_8.c gcc-4.4.0/libgfortran/generated/eoshift1_8.c *** gcc-4.3.3/libgfortran/generated/eoshift1_8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/eoshift1_8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** eoshift1 (gfc_array_char * const restric *** 42,55 **** const gfc_array_i8 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_8 * const restrict pwhich, ! index_type size, char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; char *rptr; ! char *dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; --- 37,50 ---- const gfc_array_i8 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_8 * const restrict pwhich, ! index_type size, const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; char *rptr; ! char * restrict dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; *************** eoshift1 (gfc_array_char * const restric *** 102,107 **** --- 97,107 ---- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; } } + else + { + if (size0 ((array_t *) ret) == 0) + return; + } n = 0; for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) *************** eoshift1 (gfc_array_char * const restric *** 183,189 **** else while (n--) { ! memset (dest, filler, size); dest += roffset; } --- 183,196 ---- else while (n--) { ! index_type i; ! ! if (filler_len == 1) ! memset (dest, filler[0], size); ! else ! for (i = 0; i < size; i += filler_len) ! memcpy (&dest[i], filler, filler_len); ! dest += roffset; } *************** eoshift1_8 (gfc_array_char * const restr *** 234,242 **** const char * const restrict pbound, const GFC_INTEGER_8 * const restrict pwhich) { ! eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); } void eoshift1_8_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, --- 241,251 ---- const char * const restrict pbound, const GFC_INTEGER_8 * const restrict pwhich) { ! eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), ! "\0", 1); } + void eoshift1_8_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, *************** eoshift1_8_char (gfc_array_char * const *** 256,262 **** GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { ! eoshift1 (ret, array, h, pbound, pwhich, array_length, ' '); } #endif --- 265,296 ---- GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { ! eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1); ! } ! ! ! void eoshift1_8_char4 (gfc_array_char * const restrict, ! GFC_INTEGER_4, ! const gfc_array_char * const restrict, ! const gfc_array_i8 * const restrict, ! const char * const restrict, ! const GFC_INTEGER_8 * const restrict, ! GFC_INTEGER_4, GFC_INTEGER_4); ! export_proto(eoshift1_8_char4); ! ! void ! eoshift1_8_char4 (gfc_array_char * const restrict ret, ! GFC_INTEGER_4 ret_length __attribute__((unused)), ! const gfc_array_char * const restrict array, ! const gfc_array_i8 * const restrict h, ! const char * const restrict pbound, ! const GFC_INTEGER_8 * const restrict pwhich, ! GFC_INTEGER_4 array_length, ! GFC_INTEGER_4 bound_length __attribute__((unused))) ! { ! static const gfc_char4_t space = (unsigned char) ' '; ! eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t), ! (const char *) &space, sizeof (gfc_char4_t)); } #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/eoshift3_16.c gcc-4.4.0/libgfortran/generated/eoshift3_16.c *** gcc-4.3.3/libgfortran/generated/eoshift3_16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/eoshift3_16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** eoshift3 (gfc_array_char * const restric *** 42,55 **** const gfc_array_i16 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_16 * const restrict pwhich, ! index_type size, char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; char *rptr; ! char *dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; --- 37,50 ---- const gfc_array_i16 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_16 * const restrict pwhich, ! index_type size, const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; char *rptr; ! char * restrict dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; *************** eoshift3 (gfc_array_char * const restric *** 103,108 **** --- 98,108 ---- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; } } + else + { + if (size0 ((array_t *) ret) == 0) + return; + } extent[0] = 1; *************** eoshift3 (gfc_array_char * const restric *** 198,204 **** else while (n--) { ! memset (dest, filler, size); dest += roffset; } --- 198,211 ---- else while (n--) { ! index_type i; ! ! if (filler_len == 1) ! memset (dest, filler[0], size); ! else ! for (i = 0; i < size; i += filler_len) ! memcpy (&dest[i], filler, filler_len); ! dest += roffset; } *************** eoshift3_16 (gfc_array_char * const rest *** 253,261 **** const gfc_array_char * const restrict bound, const GFC_INTEGER_16 * const restrict pwhich) { ! eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); } extern void eoshift3_16_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, --- 260,270 ---- const gfc_array_char * const restrict bound, const GFC_INTEGER_16 * const restrict pwhich) { ! eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), ! "\0", 1); } + extern void eoshift3_16_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, *************** eoshift3_16_char (gfc_array_char * const *** 275,281 **** GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { ! eoshift3 (ret, array, h, bound, pwhich, array_length, ' '); } #endif --- 284,315 ---- GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { ! eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1); ! } ! ! ! extern void eoshift3_16_char4 (gfc_array_char * const restrict, ! GFC_INTEGER_4, ! const gfc_array_char * const restrict, ! const gfc_array_i16 * const restrict, ! const gfc_array_char * const restrict, ! const GFC_INTEGER_16 * const restrict, ! GFC_INTEGER_4, GFC_INTEGER_4); ! export_proto(eoshift3_16_char4); ! ! void ! eoshift3_16_char4 (gfc_array_char * const restrict ret, ! GFC_INTEGER_4 ret_length __attribute__((unused)), ! const gfc_array_char * const restrict array, ! const gfc_array_i16 * const restrict h, ! const gfc_array_char * const restrict bound, ! const GFC_INTEGER_16 * const restrict pwhich, ! GFC_INTEGER_4 array_length, ! GFC_INTEGER_4 bound_length __attribute__((unused))) ! { ! static const gfc_char4_t space = (unsigned char) ' '; ! eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t), ! (const char *) &space, sizeof (gfc_char4_t)); } #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/eoshift3_4.c gcc-4.4.0/libgfortran/generated/eoshift3_4.c *** gcc-4.3.3/libgfortran/generated/eoshift3_4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/eoshift3_4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** eoshift3 (gfc_array_char * const restric *** 42,55 **** const gfc_array_i4 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_4 * const restrict pwhich, ! index_type size, char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; char *rptr; ! char *dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; --- 37,50 ---- const gfc_array_i4 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_4 * const restrict pwhich, ! index_type size, const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; char *rptr; ! char * restrict dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; *************** eoshift3 (gfc_array_char * const restric *** 103,108 **** --- 98,108 ---- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; } } + else + { + if (size0 ((array_t *) ret) == 0) + return; + } extent[0] = 1; *************** eoshift3 (gfc_array_char * const restric *** 198,204 **** else while (n--) { ! memset (dest, filler, size); dest += roffset; } --- 198,211 ---- else while (n--) { ! index_type i; ! ! if (filler_len == 1) ! memset (dest, filler[0], size); ! else ! for (i = 0; i < size; i += filler_len) ! memcpy (&dest[i], filler, filler_len); ! dest += roffset; } *************** eoshift3_4 (gfc_array_char * const restr *** 253,261 **** const gfc_array_char * const restrict bound, const GFC_INTEGER_4 * const restrict pwhich) { ! eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); } extern void eoshift3_4_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, --- 260,270 ---- const gfc_array_char * const restrict bound, const GFC_INTEGER_4 * const restrict pwhich) { ! eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), ! "\0", 1); } + extern void eoshift3_4_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, *************** eoshift3_4_char (gfc_array_char * const *** 275,281 **** GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { ! eoshift3 (ret, array, h, bound, pwhich, array_length, ' '); } #endif --- 284,315 ---- GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { ! eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1); ! } ! ! ! extern void eoshift3_4_char4 (gfc_array_char * const restrict, ! GFC_INTEGER_4, ! const gfc_array_char * const restrict, ! const gfc_array_i4 * const restrict, ! const gfc_array_char * const restrict, ! const GFC_INTEGER_4 * const restrict, ! GFC_INTEGER_4, GFC_INTEGER_4); ! export_proto(eoshift3_4_char4); ! ! void ! eoshift3_4_char4 (gfc_array_char * const restrict ret, ! GFC_INTEGER_4 ret_length __attribute__((unused)), ! const gfc_array_char * const restrict array, ! const gfc_array_i4 * const restrict h, ! const gfc_array_char * const restrict bound, ! const GFC_INTEGER_4 * const restrict pwhich, ! GFC_INTEGER_4 array_length, ! GFC_INTEGER_4 bound_length __attribute__((unused))) ! { ! static const gfc_char4_t space = (unsigned char) ' '; ! eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t), ! (const char *) &space, sizeof (gfc_char4_t)); } #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/eoshift3_8.c gcc-4.4.0/libgfortran/generated/eoshift3_8.c *** gcc-4.3.3/libgfortran/generated/eoshift3_8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/eoshift3_8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** eoshift3 (gfc_array_char * const restric *** 42,55 **** const gfc_array_i8 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_8 * const restrict pwhich, ! index_type size, char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; char *rptr; ! char *dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; --- 37,50 ---- const gfc_array_i8 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_8 * const restrict pwhich, ! index_type size, const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; char *rptr; ! char * restrict dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; *************** eoshift3 (gfc_array_char * const restric *** 103,108 **** --- 98,108 ---- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; } } + else + { + if (size0 ((array_t *) ret) == 0) + return; + } extent[0] = 1; *************** eoshift3 (gfc_array_char * const restric *** 198,204 **** else while (n--) { ! memset (dest, filler, size); dest += roffset; } --- 198,211 ---- else while (n--) { ! index_type i; ! ! if (filler_len == 1) ! memset (dest, filler[0], size); ! else ! for (i = 0; i < size; i += filler_len) ! memcpy (&dest[i], filler, filler_len); ! dest += roffset; } *************** eoshift3_8 (gfc_array_char * const restr *** 253,261 **** const gfc_array_char * const restrict bound, const GFC_INTEGER_8 * const restrict pwhich) { ! eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); } extern void eoshift3_8_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, --- 260,270 ---- const gfc_array_char * const restrict bound, const GFC_INTEGER_8 * const restrict pwhich) { ! eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), ! "\0", 1); } + extern void eoshift3_8_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, *************** eoshift3_8_char (gfc_array_char * const *** 275,281 **** GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { ! eoshift3 (ret, array, h, bound, pwhich, array_length, ' '); } #endif --- 284,315 ---- GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { ! eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1); ! } ! ! ! extern void eoshift3_8_char4 (gfc_array_char * const restrict, ! GFC_INTEGER_4, ! const gfc_array_char * const restrict, ! const gfc_array_i8 * const restrict, ! const gfc_array_char * const restrict, ! const GFC_INTEGER_8 * const restrict, ! GFC_INTEGER_4, GFC_INTEGER_4); ! export_proto(eoshift3_8_char4); ! ! void ! eoshift3_8_char4 (gfc_array_char * const restrict ret, ! GFC_INTEGER_4 ret_length __attribute__((unused)), ! const gfc_array_char * const restrict array, ! const gfc_array_i8 * const restrict h, ! const gfc_array_char * const restrict bound, ! const GFC_INTEGER_8 * const restrict pwhich, ! GFC_INTEGER_4 array_length, ! GFC_INTEGER_4 bound_length __attribute__((unused))) ! { ! static const gfc_char4_t space = (unsigned char) ' '; ! eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t), ! (const char *) &space, sizeof (gfc_char4_t)); } #endif diff -Nrcpad gcc-4.3.3/libgfortran/generated/exponent_r10.c gcc-4.4.0/libgfortran/generated/exponent_r10.c *** gcc-4.3.3/libgfortran/generated/exponent_r10.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/exponent_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the EXPONENT intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the EXPONENT intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/exponent_r16.c gcc-4.4.0/libgfortran/generated/exponent_r16.c *** gcc-4.3.3/libgfortran/generated/exponent_r16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/exponent_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the EXPONENT intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the EXPONENT intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/exponent_r4.c gcc-4.4.0/libgfortran/generated/exponent_r4.c *** gcc-4.3.3/libgfortran/generated/exponent_r4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/exponent_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the EXPONENT intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the EXPONENT intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/exponent_r8.c gcc-4.4.0/libgfortran/generated/exponent_r8.c *** gcc-4.3.3/libgfortran/generated/exponent_r8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/exponent_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the EXPONENT intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the EXPONENT intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/fraction_r10.c gcc-4.4.0/libgfortran/generated/fraction_r10.c *** gcc-4.3.3/libgfortran/generated/fraction_r10.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/fraction_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the FRACTION intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the FRACTION intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/fraction_r16.c gcc-4.4.0/libgfortran/generated/fraction_r16.c *** gcc-4.3.3/libgfortran/generated/fraction_r16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/fraction_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the FRACTION intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the FRACTION intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/fraction_r4.c gcc-4.4.0/libgfortran/generated/fraction_r4.c *** gcc-4.3.3/libgfortran/generated/fraction_r4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/fraction_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the FRACTION intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the FRACTION intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/fraction_r8.c gcc-4.4.0/libgfortran/generated/fraction_r8.c *** gcc-4.3.3/libgfortran/generated/fraction_r8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/fraction_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the FRACTION intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the FRACTION intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_pack_c10.c gcc-4.4.0/libgfortran/generated/in_pack_c10.c *** gcc-4.3.3/libgfortran/generated/in_pack_c10.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/in_pack_c10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_pack_c10 (gfc_array_c10 * sourc *** 48,54 **** index_type dim; index_type ssize; const GFC_COMPLEX_10 *src; ! GFC_COMPLEX_10 *dest; GFC_COMPLEX_10 *destptr; int n; int packed; --- 43,49 ---- index_type dim; index_type ssize; const GFC_COMPLEX_10 *src; ! GFC_COMPLEX_10 * restrict dest; GFC_COMPLEX_10 *destptr; int n; int packed; diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_pack_c16.c gcc-4.4.0/libgfortran/generated/in_pack_c16.c *** gcc-4.3.3/libgfortran/generated/in_pack_c16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/in_pack_c16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_pack_c16 (gfc_array_c16 * sourc *** 48,54 **** index_type dim; index_type ssize; const GFC_COMPLEX_16 *src; ! GFC_COMPLEX_16 *dest; GFC_COMPLEX_16 *destptr; int n; int packed; --- 43,49 ---- index_type dim; index_type ssize; const GFC_COMPLEX_16 *src; ! GFC_COMPLEX_16 * restrict dest; GFC_COMPLEX_16 *destptr; int n; int packed; diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_pack_c4.c gcc-4.4.0/libgfortran/generated/in_pack_c4.c *** gcc-4.3.3/libgfortran/generated/in_pack_c4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/in_pack_c4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_pack_c4 (gfc_array_c4 * source) *** 48,54 **** index_type dim; index_type ssize; const GFC_COMPLEX_4 *src; ! GFC_COMPLEX_4 *dest; GFC_COMPLEX_4 *destptr; int n; int packed; --- 43,49 ---- index_type dim; index_type ssize; const GFC_COMPLEX_4 *src; ! GFC_COMPLEX_4 * restrict dest; GFC_COMPLEX_4 *destptr; int n; int packed; diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_pack_c8.c gcc-4.4.0/libgfortran/generated/in_pack_c8.c *** gcc-4.3.3/libgfortran/generated/in_pack_c8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/in_pack_c8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_pack_c8 (gfc_array_c8 * source) *** 48,54 **** index_type dim; index_type ssize; const GFC_COMPLEX_8 *src; ! GFC_COMPLEX_8 *dest; GFC_COMPLEX_8 *destptr; int n; int packed; --- 43,49 ---- index_type dim; index_type ssize; const GFC_COMPLEX_8 *src; ! GFC_COMPLEX_8 * restrict dest; GFC_COMPLEX_8 *destptr; int n; int packed; diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_pack_i1.c gcc-4.4.0/libgfortran/generated/in_pack_i1.c *** gcc-4.3.3/libgfortran/generated/in_pack_i1.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/in_pack_i1.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,119 ---- + /* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + + + #if defined (HAVE_GFC_INTEGER_1) + + /* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + + GFC_INTEGER_1 * + internal_pack_1 (gfc_array_i1 * source) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type ssize; + const GFC_INTEGER_1 *src; + GFC_INTEGER_1 * restrict dest; + GFC_INTEGER_1 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = source->dim[n].stride; + extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (extent[n] <= 0) + { + /* Do nothing. */ + packed = 1; + break; + } + + if (ssize != stride[n]) + packed = 0; + + ssize *= extent[n]; + } + + if (packed) + return source->data; + + /* Allocate storage for the destination. */ + destptr = (GFC_INTEGER_1 *)internal_malloc_size (ssize * sizeof (GFC_INTEGER_1)); + dest = destptr; + src = source->data; + stride0 = stride[0]; + + + while (src) + { + /* Copy the data. */ + *(dest++) = *src; + /* Advance to the next element. */ + src += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + src -= stride[n] * extent[n]; + n++; + if (n == dim) + { + src = NULL; + break; + } + else + { + count[n]++; + src += stride[n]; + } + } + } + return destptr; + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_pack_i16.c gcc-4.4.0/libgfortran/generated/in_pack_i16.c *** gcc-4.3.3/libgfortran/generated/in_pack_i16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/in_pack_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_pack_16 (gfc_array_i16 * source *** 48,54 **** index_type dim; index_type ssize; const GFC_INTEGER_16 *src; ! GFC_INTEGER_16 *dest; GFC_INTEGER_16 *destptr; int n; int packed; --- 43,49 ---- index_type dim; index_type ssize; const GFC_INTEGER_16 *src; ! GFC_INTEGER_16 * restrict dest; GFC_INTEGER_16 *destptr; int n; int packed; diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_pack_i2.c gcc-4.4.0/libgfortran/generated/in_pack_i2.c *** gcc-4.3.3/libgfortran/generated/in_pack_i2.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/in_pack_i2.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,119 ---- + /* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + + + #if defined (HAVE_GFC_INTEGER_2) + + /* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + + GFC_INTEGER_2 * + internal_pack_2 (gfc_array_i2 * source) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type ssize; + const GFC_INTEGER_2 *src; + GFC_INTEGER_2 * restrict dest; + GFC_INTEGER_2 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = source->dim[n].stride; + extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (extent[n] <= 0) + { + /* Do nothing. */ + packed = 1; + break; + } + + if (ssize != stride[n]) + packed = 0; + + ssize *= extent[n]; + } + + if (packed) + return source->data; + + /* Allocate storage for the destination. */ + destptr = (GFC_INTEGER_2 *)internal_malloc_size (ssize * sizeof (GFC_INTEGER_2)); + dest = destptr; + src = source->data; + stride0 = stride[0]; + + + while (src) + { + /* Copy the data. */ + *(dest++) = *src; + /* Advance to the next element. */ + src += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + src -= stride[n] * extent[n]; + n++; + if (n == dim) + { + src = NULL; + break; + } + else + { + count[n]++; + src += stride[n]; + } + } + } + return destptr; + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_pack_i4.c gcc-4.4.0/libgfortran/generated/in_pack_i4.c *** gcc-4.3.3/libgfortran/generated/in_pack_i4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/in_pack_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_pack_4 (gfc_array_i4 * source) *** 48,54 **** index_type dim; index_type ssize; const GFC_INTEGER_4 *src; ! GFC_INTEGER_4 *dest; GFC_INTEGER_4 *destptr; int n; int packed; --- 43,49 ---- index_type dim; index_type ssize; const GFC_INTEGER_4 *src; ! GFC_INTEGER_4 * restrict dest; GFC_INTEGER_4 *destptr; int n; int packed; diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_pack_i8.c gcc-4.4.0/libgfortran/generated/in_pack_i8.c *** gcc-4.3.3/libgfortran/generated/in_pack_i8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/in_pack_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_pack_8 (gfc_array_i8 * source) *** 48,54 **** index_type dim; index_type ssize; const GFC_INTEGER_8 *src; ! GFC_INTEGER_8 *dest; GFC_INTEGER_8 *destptr; int n; int packed; --- 43,49 ---- index_type dim; index_type ssize; const GFC_INTEGER_8 *src; ! GFC_INTEGER_8 * restrict dest; GFC_INTEGER_8 *destptr; int n; int packed; diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_pack_r10.c gcc-4.4.0/libgfortran/generated/in_pack_r10.c *** gcc-4.3.3/libgfortran/generated/in_pack_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/in_pack_r10.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,119 ---- + /* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + + + #if defined (HAVE_GFC_REAL_10) + + /* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + + GFC_REAL_10 * + internal_pack_r10 (gfc_array_r10 * source) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type ssize; + const GFC_REAL_10 *src; + GFC_REAL_10 * restrict dest; + GFC_REAL_10 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = source->dim[n].stride; + extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (extent[n] <= 0) + { + /* Do nothing. */ + packed = 1; + break; + } + + if (ssize != stride[n]) + packed = 0; + + ssize *= extent[n]; + } + + if (packed) + return source->data; + + /* Allocate storage for the destination. */ + destptr = (GFC_REAL_10 *)internal_malloc_size (ssize * sizeof (GFC_REAL_10)); + dest = destptr; + src = source->data; + stride0 = stride[0]; + + + while (src) + { + /* Copy the data. */ + *(dest++) = *src; + /* Advance to the next element. */ + src += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + src -= stride[n] * extent[n]; + n++; + if (n == dim) + { + src = NULL; + break; + } + else + { + count[n]++; + src += stride[n]; + } + } + } + return destptr; + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_pack_r16.c gcc-4.4.0/libgfortran/generated/in_pack_r16.c *** gcc-4.3.3/libgfortran/generated/in_pack_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/in_pack_r16.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,119 ---- + /* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + + + #if defined (HAVE_GFC_REAL_16) + + /* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + + GFC_REAL_16 * + internal_pack_r16 (gfc_array_r16 * source) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type ssize; + const GFC_REAL_16 *src; + GFC_REAL_16 * restrict dest; + GFC_REAL_16 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = source->dim[n].stride; + extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (extent[n] <= 0) + { + /* Do nothing. */ + packed = 1; + break; + } + + if (ssize != stride[n]) + packed = 0; + + ssize *= extent[n]; + } + + if (packed) + return source->data; + + /* Allocate storage for the destination. */ + destptr = (GFC_REAL_16 *)internal_malloc_size (ssize * sizeof (GFC_REAL_16)); + dest = destptr; + src = source->data; + stride0 = stride[0]; + + + while (src) + { + /* Copy the data. */ + *(dest++) = *src; + /* Advance to the next element. */ + src += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + src -= stride[n] * extent[n]; + n++; + if (n == dim) + { + src = NULL; + break; + } + else + { + count[n]++; + src += stride[n]; + } + } + } + return destptr; + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_pack_r4.c gcc-4.4.0/libgfortran/generated/in_pack_r4.c *** gcc-4.3.3/libgfortran/generated/in_pack_r4.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/in_pack_r4.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,119 ---- + /* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + + + #if defined (HAVE_GFC_REAL_4) + + /* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + + GFC_REAL_4 * + internal_pack_r4 (gfc_array_r4 * source) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type ssize; + const GFC_REAL_4 *src; + GFC_REAL_4 * restrict dest; + GFC_REAL_4 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = source->dim[n].stride; + extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (extent[n] <= 0) + { + /* Do nothing. */ + packed = 1; + break; + } + + if (ssize != stride[n]) + packed = 0; + + ssize *= extent[n]; + } + + if (packed) + return source->data; + + /* Allocate storage for the destination. */ + destptr = (GFC_REAL_4 *)internal_malloc_size (ssize * sizeof (GFC_REAL_4)); + dest = destptr; + src = source->data; + stride0 = stride[0]; + + + while (src) + { + /* Copy the data. */ + *(dest++) = *src; + /* Advance to the next element. */ + src += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + src -= stride[n] * extent[n]; + n++; + if (n == dim) + { + src = NULL; + break; + } + else + { + count[n]++; + src += stride[n]; + } + } + } + return destptr; + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_pack_r8.c gcc-4.4.0/libgfortran/generated/in_pack_r8.c *** gcc-4.3.3/libgfortran/generated/in_pack_r8.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/in_pack_r8.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,119 ---- + /* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + + + #if defined (HAVE_GFC_REAL_8) + + /* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + + GFC_REAL_8 * + internal_pack_r8 (gfc_array_r8 * source) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type ssize; + const GFC_REAL_8 *src; + GFC_REAL_8 * restrict dest; + GFC_REAL_8 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = source->dim[n].stride; + extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (extent[n] <= 0) + { + /* Do nothing. */ + packed = 1; + break; + } + + if (ssize != stride[n]) + packed = 0; + + ssize *= extent[n]; + } + + if (packed) + return source->data; + + /* Allocate storage for the destination. */ + destptr = (GFC_REAL_8 *)internal_malloc_size (ssize * sizeof (GFC_REAL_8)); + dest = destptr; + src = source->data; + stride0 = stride[0]; + + + while (src) + { + /* Copy the data. */ + *(dest++) = *src; + /* Advance to the next element. */ + src += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + src -= stride[n] * extent[n]; + n++; + if (n == dim) + { + src = NULL; + break; + } + else + { + count[n]++; + src += stride[n]; + } + } + } + return destptr; + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_unpack_c10.c gcc-4.4.0/libgfortran/generated/in_unpack_c10.c *** gcc-4.3.3/libgfortran/generated/in_unpack_c10.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/in_unpack_c10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_unpack_c10 (gfc_array_c10 * d, *** 45,51 **** index_type stride0; index_type dim; index_type dsize; ! GFC_COMPLEX_10 *dest; int n; dest = d->data; --- 40,46 ---- index_type stride0; index_type dim; index_type dsize; ! GFC_COMPLEX_10 * restrict dest; int n; dest = d->data; *************** internal_unpack_c10 (gfc_array_c10 * d, *** 60,71 **** stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! abort (); if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } if (dsize != 0) --- 55,66 ---- stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! return; if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } if (dsize != 0) diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_unpack_c16.c gcc-4.4.0/libgfortran/generated/in_unpack_c16.c *** gcc-4.3.3/libgfortran/generated/in_unpack_c16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/in_unpack_c16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_unpack_c16 (gfc_array_c16 * d, *** 45,51 **** index_type stride0; index_type dim; index_type dsize; ! GFC_COMPLEX_16 *dest; int n; dest = d->data; --- 40,46 ---- index_type stride0; index_type dim; index_type dsize; ! GFC_COMPLEX_16 * restrict dest; int n; dest = d->data; *************** internal_unpack_c16 (gfc_array_c16 * d, *** 60,71 **** stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! abort (); if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } if (dsize != 0) --- 55,66 ---- stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! return; if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } if (dsize != 0) diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_unpack_c4.c gcc-4.4.0/libgfortran/generated/in_unpack_c4.c *** gcc-4.3.3/libgfortran/generated/in_unpack_c4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/in_unpack_c4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_unpack_c4 (gfc_array_c4 * d, co *** 45,51 **** index_type stride0; index_type dim; index_type dsize; ! GFC_COMPLEX_4 *dest; int n; dest = d->data; --- 40,46 ---- index_type stride0; index_type dim; index_type dsize; ! GFC_COMPLEX_4 * restrict dest; int n; dest = d->data; *************** internal_unpack_c4 (gfc_array_c4 * d, co *** 60,71 **** stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! abort (); if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } if (dsize != 0) --- 55,66 ---- stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! return; if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } if (dsize != 0) diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_unpack_c8.c gcc-4.4.0/libgfortran/generated/in_unpack_c8.c *** gcc-4.3.3/libgfortran/generated/in_unpack_c8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/in_unpack_c8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_unpack_c8 (gfc_array_c8 * d, co *** 45,51 **** index_type stride0; index_type dim; index_type dsize; ! GFC_COMPLEX_8 *dest; int n; dest = d->data; --- 40,46 ---- index_type stride0; index_type dim; index_type dsize; ! GFC_COMPLEX_8 * restrict dest; int n; dest = d->data; *************** internal_unpack_c8 (gfc_array_c8 * d, co *** 60,71 **** stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! abort (); if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } if (dsize != 0) --- 55,66 ---- stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! return; if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } if (dsize != 0) diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_unpack_i1.c gcc-4.4.0/libgfortran/generated/in_unpack_i1.c *** gcc-4.3.3/libgfortran/generated/in_unpack_i1.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/in_unpack_i1.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,107 ---- + /* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_1) + + void + internal_unpack_1 (gfc_array_i1 * d, const GFC_INTEGER_1 * src) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type dsize; + GFC_INTEGER_1 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = d->dim[n].stride; + extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_INTEGER_1)); + return; + } + + stride0 = stride[0]; + + while (dest) + { + /* Copy the data. */ + *dest = *(src++); + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_unpack_i16.c gcc-4.4.0/libgfortran/generated/in_unpack_i16.c *** gcc-4.3.3/libgfortran/generated/in_unpack_i16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/in_unpack_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_unpack_16 (gfc_array_i16 * d, c *** 45,51 **** index_type stride0; index_type dim; index_type dsize; ! GFC_INTEGER_16 *dest; int n; dest = d->data; --- 40,46 ---- index_type stride0; index_type dim; index_type dsize; ! GFC_INTEGER_16 * restrict dest; int n; dest = d->data; *************** internal_unpack_16 (gfc_array_i16 * d, c *** 60,71 **** stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! abort (); if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } if (dsize != 0) --- 55,66 ---- stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! return; if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } if (dsize != 0) diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_unpack_i2.c gcc-4.4.0/libgfortran/generated/in_unpack_i2.c *** gcc-4.3.3/libgfortran/generated/in_unpack_i2.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/in_unpack_i2.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,107 ---- + /* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_2) + + void + internal_unpack_2 (gfc_array_i2 * d, const GFC_INTEGER_2 * src) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type dsize; + GFC_INTEGER_2 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = d->dim[n].stride; + extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_INTEGER_2)); + return; + } + + stride0 = stride[0]; + + while (dest) + { + /* Copy the data. */ + *dest = *(src++); + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_unpack_i4.c gcc-4.4.0/libgfortran/generated/in_unpack_i4.c *** gcc-4.3.3/libgfortran/generated/in_unpack_i4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/in_unpack_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_unpack_4 (gfc_array_i4 * d, con *** 45,51 **** index_type stride0; index_type dim; index_type dsize; ! GFC_INTEGER_4 *dest; int n; dest = d->data; --- 40,46 ---- index_type stride0; index_type dim; index_type dsize; ! GFC_INTEGER_4 * restrict dest; int n; dest = d->data; *************** internal_unpack_4 (gfc_array_i4 * d, con *** 60,71 **** stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! abort (); if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } if (dsize != 0) --- 55,66 ---- stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! return; if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } if (dsize != 0) diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_unpack_i8.c gcc-4.4.0/libgfortran/generated/in_unpack_i8.c *** gcc-4.3.3/libgfortran/generated/in_unpack_i8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/in_unpack_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_unpack_8 (gfc_array_i8 * d, con *** 45,51 **** index_type stride0; index_type dim; index_type dsize; ! GFC_INTEGER_8 *dest; int n; dest = d->data; --- 40,46 ---- index_type stride0; index_type dim; index_type dsize; ! GFC_INTEGER_8 * restrict dest; int n; dest = d->data; *************** internal_unpack_8 (gfc_array_i8 * d, con *** 60,71 **** stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! abort (); if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } if (dsize != 0) --- 55,66 ---- stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! return; if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } if (dsize != 0) diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_unpack_r10.c gcc-4.4.0/libgfortran/generated/in_unpack_r10.c *** gcc-4.3.3/libgfortran/generated/in_unpack_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/in_unpack_r10.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,107 ---- + /* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_10) + + void + internal_unpack_r10 (gfc_array_r10 * d, const GFC_REAL_10 * src) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type dsize; + GFC_REAL_10 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = d->dim[n].stride; + extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_REAL_10)); + return; + } + + stride0 = stride[0]; + + while (dest) + { + /* Copy the data. */ + *dest = *(src++); + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_unpack_r16.c gcc-4.4.0/libgfortran/generated/in_unpack_r16.c *** gcc-4.3.3/libgfortran/generated/in_unpack_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/in_unpack_r16.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,107 ---- + /* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_16) + + void + internal_unpack_r16 (gfc_array_r16 * d, const GFC_REAL_16 * src) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type dsize; + GFC_REAL_16 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = d->dim[n].stride; + extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_REAL_16)); + return; + } + + stride0 = stride[0]; + + while (dest) + { + /* Copy the data. */ + *dest = *(src++); + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_unpack_r4.c gcc-4.4.0/libgfortran/generated/in_unpack_r4.c *** gcc-4.3.3/libgfortran/generated/in_unpack_r4.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/in_unpack_r4.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,107 ---- + /* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_4) + + void + internal_unpack_r4 (gfc_array_r4 * d, const GFC_REAL_4 * src) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type dsize; + GFC_REAL_4 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = d->dim[n].stride; + extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_REAL_4)); + return; + } + + stride0 = stride[0]; + + while (dest) + { + /* Copy the data. */ + *dest = *(src++); + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/in_unpack_r8.c gcc-4.4.0/libgfortran/generated/in_unpack_r8.c *** gcc-4.3.3/libgfortran/generated/in_unpack_r8.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/in_unpack_r8.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,107 ---- + /* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_8) + + void + internal_unpack_r8 (gfc_array_r8 * d, const GFC_REAL_8 * src) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type dsize; + GFC_REAL_8 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = d->dim[n].stride; + extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_REAL_8)); + return; + } + + stride0 = stride[0]; + + while (dest) + { + /* Copy the data. */ + *dest = *(src++); + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/matmul_c10.c gcc-4.4.0/libgfortran/generated/matmul_c10.c *** gcc-4.3.3/libgfortran/generated/matmul_c10.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/matmul_c10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_c10 (gfc_array_c10 * const restri *** 135,140 **** --- 130,176 ---- = internal_malloc_size (sizeof (GFC_COMPLEX_10) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } if (GFC_DESCRIPTOR_RANK (retarray) == 1) *************** matmul_c10 (gfc_array_c10 * const restri *** 170,176 **** } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); if (GFC_DESCRIPTOR_RANK (b) == 1) { --- 206,215 ---- } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! { ! if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); ! } if (GFC_DESCRIPTOR_RANK (b) == 1) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/matmul_c16.c gcc-4.4.0/libgfortran/generated/matmul_c16.c *** gcc-4.3.3/libgfortran/generated/matmul_c16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/matmul_c16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_c16 (gfc_array_c16 * const restri *** 135,140 **** --- 130,176 ---- = internal_malloc_size (sizeof (GFC_COMPLEX_16) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } if (GFC_DESCRIPTOR_RANK (retarray) == 1) *************** matmul_c16 (gfc_array_c16 * const restri *** 170,176 **** } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); if (GFC_DESCRIPTOR_RANK (b) == 1) { --- 206,215 ---- } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! { ! if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); ! } if (GFC_DESCRIPTOR_RANK (b) == 1) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/matmul_c4.c gcc-4.4.0/libgfortran/generated/matmul_c4.c *** gcc-4.3.3/libgfortran/generated/matmul_c4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/matmul_c4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_c4 (gfc_array_c4 * const restrict *** 135,140 **** --- 130,176 ---- = internal_malloc_size (sizeof (GFC_COMPLEX_4) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } if (GFC_DESCRIPTOR_RANK (retarray) == 1) *************** matmul_c4 (gfc_array_c4 * const restrict *** 170,176 **** } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); if (GFC_DESCRIPTOR_RANK (b) == 1) { --- 206,215 ---- } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! { ! if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); ! } if (GFC_DESCRIPTOR_RANK (b) == 1) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/matmul_c8.c gcc-4.4.0/libgfortran/generated/matmul_c8.c *** gcc-4.3.3/libgfortran/generated/matmul_c8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/matmul_c8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_c8 (gfc_array_c8 * const restrict *** 135,140 **** --- 130,176 ---- = internal_malloc_size (sizeof (GFC_COMPLEX_8) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } if (GFC_DESCRIPTOR_RANK (retarray) == 1) *************** matmul_c8 (gfc_array_c8 * const restrict *** 170,176 **** } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); if (GFC_DESCRIPTOR_RANK (b) == 1) { --- 206,215 ---- } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! { ! if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); ! } if (GFC_DESCRIPTOR_RANK (b) == 1) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/matmul_i1.c gcc-4.4.0/libgfortran/generated/matmul_i1.c *** gcc-4.3.3/libgfortran/generated/matmul_i1.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/matmul_i1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_i1 (gfc_array_i1 * const restrict *** 135,140 **** --- 130,176 ---- = internal_malloc_size (sizeof (GFC_INTEGER_1) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } if (GFC_DESCRIPTOR_RANK (retarray) == 1) *************** matmul_i1 (gfc_array_i1 * const restrict *** 170,176 **** } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); if (GFC_DESCRIPTOR_RANK (b) == 1) { --- 206,215 ---- } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! { ! if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); ! } if (GFC_DESCRIPTOR_RANK (b) == 1) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/matmul_i16.c gcc-4.4.0/libgfortran/generated/matmul_i16.c *** gcc-4.3.3/libgfortran/generated/matmul_i16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/matmul_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_i16 (gfc_array_i16 * const restri *** 135,140 **** --- 130,176 ---- = internal_malloc_size (sizeof (GFC_INTEGER_16) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } if (GFC_DESCRIPTOR_RANK (retarray) == 1) *************** matmul_i16 (gfc_array_i16 * const restri *** 170,176 **** } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); if (GFC_DESCRIPTOR_RANK (b) == 1) { --- 206,215 ---- } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! { ! if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); ! } if (GFC_DESCRIPTOR_RANK (b) == 1) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/matmul_i2.c gcc-4.4.0/libgfortran/generated/matmul_i2.c *** gcc-4.3.3/libgfortran/generated/matmul_i2.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/matmul_i2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_i2 (gfc_array_i2 * const restrict *** 135,140 **** --- 130,176 ---- = internal_malloc_size (sizeof (GFC_INTEGER_2) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } if (GFC_DESCRIPTOR_RANK (retarray) == 1) *************** matmul_i2 (gfc_array_i2 * const restrict *** 170,176 **** } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); if (GFC_DESCRIPTOR_RANK (b) == 1) { --- 206,215 ---- } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! { ! if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); ! } if (GFC_DESCRIPTOR_RANK (b) == 1) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/matmul_i4.c gcc-4.4.0/libgfortran/generated/matmul_i4.c *** gcc-4.3.3/libgfortran/generated/matmul_i4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/matmul_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_i4 (gfc_array_i4 * const restrict *** 135,140 **** --- 130,176 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } if (GFC_DESCRIPTOR_RANK (retarray) == 1) *************** matmul_i4 (gfc_array_i4 * const restrict *** 170,176 **** } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); if (GFC_DESCRIPTOR_RANK (b) == 1) { --- 206,215 ---- } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! { ! if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); ! } if (GFC_DESCRIPTOR_RANK (b) == 1) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/matmul_i8.c gcc-4.4.0/libgfortran/generated/matmul_i8.c *** gcc-4.3.3/libgfortran/generated/matmul_i8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/matmul_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_i8 (gfc_array_i8 * const restrict *** 135,140 **** --- 130,176 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } if (GFC_DESCRIPTOR_RANK (retarray) == 1) *************** matmul_i8 (gfc_array_i8 * const restrict *** 170,176 **** } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); if (GFC_DESCRIPTOR_RANK (b) == 1) { --- 206,215 ---- } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! { ! if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); ! } if (GFC_DESCRIPTOR_RANK (b) == 1) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/matmul_l16.c gcc-4.4.0/libgfortran/generated/matmul_l16.c *** gcc-4.3.3/libgfortran/generated/matmul_l16.c Tue Dec 25 10:12:41 2007 --- gcc-4.4.0/libgfortran/generated/matmul_l16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_l16 (gfc_array_l16 * const restri *** 99,104 **** --- 94,140 ---- = internal_malloc_size (sizeof (GFC_LOGICAL_16) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } abase = a->data; a_kind = GFC_DESCRIPTOR_SIZE (a); diff -Nrcpad gcc-4.3.3/libgfortran/generated/matmul_l4.c gcc-4.4.0/libgfortran/generated/matmul_l4.c *** gcc-4.3.3/libgfortran/generated/matmul_l4.c Tue Dec 25 10:12:41 2007 --- gcc-4.4.0/libgfortran/generated/matmul_l4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_l4 (gfc_array_l4 * const restrict *** 99,104 **** --- 94,140 ---- = internal_malloc_size (sizeof (GFC_LOGICAL_4) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } abase = a->data; a_kind = GFC_DESCRIPTOR_SIZE (a); diff -Nrcpad gcc-4.3.3/libgfortran/generated/matmul_l8.c gcc-4.4.0/libgfortran/generated/matmul_l8.c *** gcc-4.3.3/libgfortran/generated/matmul_l8.c Tue Dec 25 10:12:41 2007 --- gcc-4.4.0/libgfortran/generated/matmul_l8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_l8 (gfc_array_l8 * const restrict *** 99,104 **** --- 94,140 ---- = internal_malloc_size (sizeof (GFC_LOGICAL_8) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } abase = a->data; a_kind = GFC_DESCRIPTOR_SIZE (a); diff -Nrcpad gcc-4.3.3/libgfortran/generated/matmul_r10.c gcc-4.4.0/libgfortran/generated/matmul_r10.c *** gcc-4.3.3/libgfortran/generated/matmul_r10.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/matmul_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_r10 (gfc_array_r10 * const restri *** 135,140 **** --- 130,176 ---- = internal_malloc_size (sizeof (GFC_REAL_10) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } if (GFC_DESCRIPTOR_RANK (retarray) == 1) *************** matmul_r10 (gfc_array_r10 * const restri *** 170,176 **** } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); if (GFC_DESCRIPTOR_RANK (b) == 1) { --- 206,215 ---- } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! { ! if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); ! } if (GFC_DESCRIPTOR_RANK (b) == 1) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/matmul_r16.c gcc-4.4.0/libgfortran/generated/matmul_r16.c *** gcc-4.3.3/libgfortran/generated/matmul_r16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/matmul_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_r16 (gfc_array_r16 * const restri *** 135,140 **** --- 130,176 ---- = internal_malloc_size (sizeof (GFC_REAL_16) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } if (GFC_DESCRIPTOR_RANK (retarray) == 1) *************** matmul_r16 (gfc_array_r16 * const restri *** 170,176 **** } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); if (GFC_DESCRIPTOR_RANK (b) == 1) { --- 206,215 ---- } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! { ! if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); ! } if (GFC_DESCRIPTOR_RANK (b) == 1) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/matmul_r4.c gcc-4.4.0/libgfortran/generated/matmul_r4.c *** gcc-4.3.3/libgfortran/generated/matmul_r4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/matmul_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_r4 (gfc_array_r4 * const restrict *** 135,140 **** --- 130,176 ---- = internal_malloc_size (sizeof (GFC_REAL_4) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } if (GFC_DESCRIPTOR_RANK (retarray) == 1) *************** matmul_r4 (gfc_array_r4 * const restrict *** 170,176 **** } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); if (GFC_DESCRIPTOR_RANK (b) == 1) { --- 206,215 ---- } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! { ! if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); ! } if (GFC_DESCRIPTOR_RANK (b) == 1) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/matmul_r8.c gcc-4.4.0/libgfortran/generated/matmul_r8.c *** gcc-4.3.3/libgfortran/generated/matmul_r8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/matmul_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_r8 (gfc_array_r8 * const restrict *** 135,140 **** --- 130,176 ---- = internal_malloc_size (sizeof (GFC_REAL_8) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } if (GFC_DESCRIPTOR_RANK (retarray) == 1) *************** matmul_r8 (gfc_array_r8 * const restrict *** 170,176 **** } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); if (GFC_DESCRIPTOR_RANK (b) == 1) { --- 206,215 ---- } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! { ! if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); ! } if (GFC_DESCRIPTOR_RANK (b) == 1) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_16_i1.c gcc-4.4.0/libgfortran/generated/maxloc0_16_i1.c *** gcc-4.3.3/libgfortran/generated/maxloc0_16_i1.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_16_i1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_16_i1 (gfc_array_i16 * const res *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_1 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_1 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** maxloc0_16_i1 (gfc_array_i16 * const res *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_16_i1 (gfc_array_i16 * const re *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_16_i1 (gfc_array_i16 * const re *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_16_i16.c gcc-4.4.0/libgfortran/generated/maxloc0_16_i16.c *** gcc-4.3.3/libgfortran/generated/maxloc0_16_i16.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_16_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_16_i16 (gfc_array_i16 * const re *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_16 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_16 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** maxloc0_16_i16 (gfc_array_i16 * const re *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_16_i16 (gfc_array_i16 * const r *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_16_i16 (gfc_array_i16 * const r *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_16_i2.c gcc-4.4.0/libgfortran/generated/maxloc0_16_i2.c *** gcc-4.3.3/libgfortran/generated/maxloc0_16_i2.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_16_i2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_16_i2 (gfc_array_i16 * const res *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_2 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_2 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** maxloc0_16_i2 (gfc_array_i16 * const res *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_16_i2 (gfc_array_i16 * const re *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_16_i2 (gfc_array_i16 * const re *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_16_i4.c gcc-4.4.0/libgfortran/generated/maxloc0_16_i4.c *** gcc-4.3.3/libgfortran/generated/maxloc0_16_i4.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_16_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_16_i4 (gfc_array_i16 * const res *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_4 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_4 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** maxloc0_16_i4 (gfc_array_i16 * const res *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_16_i4 (gfc_array_i16 * const re *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_16_i4 (gfc_array_i16 * const re *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_16_i8.c gcc-4.4.0/libgfortran/generated/maxloc0_16_i8.c *** gcc-4.3.3/libgfortran/generated/maxloc0_16_i8.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_16_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_16_i8 (gfc_array_i16 * const res *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_8 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_8 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** maxloc0_16_i8 (gfc_array_i16 * const res *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_16_i8 (gfc_array_i16 * const re *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_16_i8 (gfc_array_i16 * const re *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_16_r10.c gcc-4.4.0/libgfortran/generated/maxloc0_16_r10.c *** gcc-4.3.3/libgfortran/generated/maxloc0_16_r10.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_16_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_16_r10 (gfc_array_i16 * const re *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_10 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_10 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** maxloc0_16_r10 (gfc_array_i16 * const re *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_16_r10 (gfc_array_i16 * const r *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_16_r10 (gfc_array_i16 * const r *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_16_r16.c gcc-4.4.0/libgfortran/generated/maxloc0_16_r16.c *** gcc-4.3.3/libgfortran/generated/maxloc0_16_r16.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_16_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_16_r16 (gfc_array_i16 * const re *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_16 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_16 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** maxloc0_16_r16 (gfc_array_i16 * const re *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_16_r16 (gfc_array_i16 * const r *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_16_r16 (gfc_array_i16 * const r *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_16_r4.c gcc-4.4.0/libgfortran/generated/maxloc0_16_r4.c *** gcc-4.3.3/libgfortran/generated/maxloc0_16_r4.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_16_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_16_r4 (gfc_array_i16 * const res *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_4 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_4 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** maxloc0_16_r4 (gfc_array_i16 * const res *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_16_r4 (gfc_array_i16 * const re *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_16_r4 (gfc_array_i16 * const re *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_16_r8.c gcc-4.4.0/libgfortran/generated/maxloc0_16_r8.c *** gcc-4.3.3/libgfortran/generated/maxloc0_16_r8.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_16_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_16_r8 (gfc_array_i16 * const res *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_8 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_8 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** maxloc0_16_r8 (gfc_array_i16 * const res *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_16_r8 (gfc_array_i16 * const re *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_16_r8 (gfc_array_i16 * const re *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_4_i1.c gcc-4.4.0/libgfortran/generated/maxloc0_4_i1.c *** gcc-4.3.3/libgfortran/generated/maxloc0_4_i1.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_4_i1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_4_i1 (gfc_array_i4 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_1 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_1 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** maxloc0_4_i1 (gfc_array_i4 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_4_i1 (gfc_array_i4 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_4_i1 (gfc_array_i4 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_4_i16.c gcc-4.4.0/libgfortran/generated/maxloc0_4_i16.c *** gcc-4.3.3/libgfortran/generated/maxloc0_4_i16.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_4_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_4_i16 (gfc_array_i4 * const rest *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_16 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_16 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** maxloc0_4_i16 (gfc_array_i4 * const rest *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_4_i16 (gfc_array_i4 * const res *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_4_i16 (gfc_array_i4 * const res *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_4_i2.c gcc-4.4.0/libgfortran/generated/maxloc0_4_i2.c *** gcc-4.3.3/libgfortran/generated/maxloc0_4_i2.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_4_i2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_4_i2 (gfc_array_i4 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_2 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_2 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** maxloc0_4_i2 (gfc_array_i4 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_4_i2 (gfc_array_i4 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_4_i2 (gfc_array_i4 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_4_i4.c gcc-4.4.0/libgfortran/generated/maxloc0_4_i4.c *** gcc-4.3.3/libgfortran/generated/maxloc0_4_i4.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_4_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_4_i4 (gfc_array_i4 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_4 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_4 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** maxloc0_4_i4 (gfc_array_i4 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_4_i4 (gfc_array_i4 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_4_i4 (gfc_array_i4 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_4_i8.c gcc-4.4.0/libgfortran/generated/maxloc0_4_i8.c *** gcc-4.3.3/libgfortran/generated/maxloc0_4_i8.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_4_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_4_i8 (gfc_array_i4 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_8 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_8 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** maxloc0_4_i8 (gfc_array_i4 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_4_i8 (gfc_array_i4 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_4_i8 (gfc_array_i4 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_4_r10.c gcc-4.4.0/libgfortran/generated/maxloc0_4_r10.c *** gcc-4.3.3/libgfortran/generated/maxloc0_4_r10.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_4_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_4_r10 (gfc_array_i4 * const rest *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_10 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_10 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** maxloc0_4_r10 (gfc_array_i4 * const rest *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_4_r10 (gfc_array_i4 * const res *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_4_r10 (gfc_array_i4 * const res *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_4_r16.c gcc-4.4.0/libgfortran/generated/maxloc0_4_r16.c *** gcc-4.3.3/libgfortran/generated/maxloc0_4_r16.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_4_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_4_r16 (gfc_array_i4 * const rest *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_16 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_16 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** maxloc0_4_r16 (gfc_array_i4 * const rest *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_4_r16 (gfc_array_i4 * const res *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_4_r16 (gfc_array_i4 * const res *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_4_r4.c gcc-4.4.0/libgfortran/generated/maxloc0_4_r4.c *** gcc-4.3.3/libgfortran/generated/maxloc0_4_r4.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_4_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_4_r4 (gfc_array_i4 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_4 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_4 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** maxloc0_4_r4 (gfc_array_i4 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_4_r4 (gfc_array_i4 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_4_r4 (gfc_array_i4 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_4_r8.c gcc-4.4.0/libgfortran/generated/maxloc0_4_r8.c *** gcc-4.3.3/libgfortran/generated/maxloc0_4_r8.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_4_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_4_r8 (gfc_array_i4 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_8 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_8 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** maxloc0_4_r8 (gfc_array_i4 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_4_r8 (gfc_array_i4 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_4_r8 (gfc_array_i4 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_8_i1.c gcc-4.4.0/libgfortran/generated/maxloc0_8_i1.c *** gcc-4.3.3/libgfortran/generated/maxloc0_8_i1.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_8_i1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_8_i1 (gfc_array_i8 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_1 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_1 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** maxloc0_8_i1 (gfc_array_i8 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_8_i1 (gfc_array_i8 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_8_i1 (gfc_array_i8 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_8_i16.c gcc-4.4.0/libgfortran/generated/maxloc0_8_i16.c *** gcc-4.3.3/libgfortran/generated/maxloc0_8_i16.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_8_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_8_i16 (gfc_array_i8 * const rest *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_16 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_16 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** maxloc0_8_i16 (gfc_array_i8 * const rest *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_8_i16 (gfc_array_i8 * const res *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_8_i16 (gfc_array_i8 * const res *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_8_i2.c gcc-4.4.0/libgfortran/generated/maxloc0_8_i2.c *** gcc-4.3.3/libgfortran/generated/maxloc0_8_i2.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_8_i2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_8_i2 (gfc_array_i8 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_2 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_2 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** maxloc0_8_i2 (gfc_array_i8 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_8_i2 (gfc_array_i8 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_8_i2 (gfc_array_i8 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_8_i4.c gcc-4.4.0/libgfortran/generated/maxloc0_8_i4.c *** gcc-4.3.3/libgfortran/generated/maxloc0_8_i4.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_8_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_8_i4 (gfc_array_i8 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_4 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_4 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** maxloc0_8_i4 (gfc_array_i8 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_8_i4 (gfc_array_i8 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_8_i4 (gfc_array_i8 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_8_i8.c gcc-4.4.0/libgfortran/generated/maxloc0_8_i8.c *** gcc-4.3.3/libgfortran/generated/maxloc0_8_i8.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_8_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_8_i8 (gfc_array_i8 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_8 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_8 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** maxloc0_8_i8 (gfc_array_i8 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_8_i8 (gfc_array_i8 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_8_i8 (gfc_array_i8 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_8_r10.c gcc-4.4.0/libgfortran/generated/maxloc0_8_r10.c *** gcc-4.3.3/libgfortran/generated/maxloc0_8_r10.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_8_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_8_r10 (gfc_array_i8 * const rest *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_10 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_10 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** maxloc0_8_r10 (gfc_array_i8 * const rest *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_8_r10 (gfc_array_i8 * const res *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_8_r10 (gfc_array_i8 * const res *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_8_r16.c gcc-4.4.0/libgfortran/generated/maxloc0_8_r16.c *** gcc-4.3.3/libgfortran/generated/maxloc0_8_r16.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_8_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_8_r16 (gfc_array_i8 * const rest *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_16 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_16 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** maxloc0_8_r16 (gfc_array_i8 * const rest *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_8_r16 (gfc_array_i8 * const res *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_8_r16 (gfc_array_i8 * const res *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_8_r4.c gcc-4.4.0/libgfortran/generated/maxloc0_8_r4.c *** gcc-4.3.3/libgfortran/generated/maxloc0_8_r4.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_8_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_8_r4 (gfc_array_i8 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_4 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_4 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** maxloc0_8_r4 (gfc_array_i8 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_8_r4 (gfc_array_i8 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_8_r4 (gfc_array_i8 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc0_8_r8.c gcc-4.4.0/libgfortran/generated/maxloc0_8_r8.c *** gcc-4.3.3/libgfortran/generated/maxloc0_8_r8.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/maxloc0_8_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc0_8_r8 (gfc_array_i8 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_8 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_8 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** maxloc0_8_r8 (gfc_array_i8 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mmaxloc0_8_r8 (gfc_array_i8 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** smaxloc0_8_r8 (gfc_array_i8 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_16_i1.c gcc-4.4.0/libgfortran/generated/maxloc1_16_i1.c *** gcc-4.3.3/libgfortran/generated/maxloc1_16_i1.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_16_i1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_16_i1 (gfc_array_i16 * const res *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_16_i1 (gfc_array_i16 * const re *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_16_i1 (gfc_array_i16 * const re *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_16_i16.c gcc-4.4.0/libgfortran/generated/maxloc1_16_i16.c *** gcc-4.3.3/libgfortran/generated/maxloc1_16_i16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_16_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_16_i16 (gfc_array_i16 * const re *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_16_i16 (gfc_array_i16 * const r *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_16_i16 (gfc_array_i16 * const r *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_16_i2.c gcc-4.4.0/libgfortran/generated/maxloc1_16_i2.c *** gcc-4.3.3/libgfortran/generated/maxloc1_16_i2.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_16_i2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_16_i2 (gfc_array_i16 * const res *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_16_i2 (gfc_array_i16 * const re *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_16_i2 (gfc_array_i16 * const re *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_16_i4.c gcc-4.4.0/libgfortran/generated/maxloc1_16_i4.c *** gcc-4.3.3/libgfortran/generated/maxloc1_16_i4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_16_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_16_i4 (gfc_array_i16 * const res *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_16_i4 (gfc_array_i16 * const re *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_16_i4 (gfc_array_i16 * const re *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_16_i8.c gcc-4.4.0/libgfortran/generated/maxloc1_16_i8.c *** gcc-4.3.3/libgfortran/generated/maxloc1_16_i8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_16_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_16_i8 (gfc_array_i16 * const res *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_16_i8 (gfc_array_i16 * const re *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_16_i8 (gfc_array_i16 * const re *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_16_r10.c gcc-4.4.0/libgfortran/generated/maxloc1_16_r10.c *** gcc-4.3.3/libgfortran/generated/maxloc1_16_r10.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_16_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_16_r10 (gfc_array_i16 * const re *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_16_r10 (gfc_array_i16 * const r *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_16_r10 (gfc_array_i16 * const r *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_16_r16.c gcc-4.4.0/libgfortran/generated/maxloc1_16_r16.c *** gcc-4.3.3/libgfortran/generated/maxloc1_16_r16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_16_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_16_r16 (gfc_array_i16 * const re *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_16_r16 (gfc_array_i16 * const r *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_16_r16 (gfc_array_i16 * const r *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_16_r4.c gcc-4.4.0/libgfortran/generated/maxloc1_16_r4.c *** gcc-4.3.3/libgfortran/generated/maxloc1_16_r4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_16_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_16_r4 (gfc_array_i16 * const res *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_16_r4 (gfc_array_i16 * const re *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_16_r4 (gfc_array_i16 * const re *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_16_r8.c gcc-4.4.0/libgfortran/generated/maxloc1_16_r8.c *** gcc-4.3.3/libgfortran/generated/maxloc1_16_r8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_16_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_16_r8 (gfc_array_i16 * const res *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_16_r8 (gfc_array_i16 * const re *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_16_r8 (gfc_array_i16 * const re *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_4_i1.c gcc-4.4.0/libgfortran/generated/maxloc1_4_i1.c *** gcc-4.3.3/libgfortran/generated/maxloc1_4_i1.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_4_i1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_4_i1 (gfc_array_i4 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_4_i1 (gfc_array_i4 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_4_i1 (gfc_array_i4 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_4_i16.c gcc-4.4.0/libgfortran/generated/maxloc1_4_i16.c *** gcc-4.3.3/libgfortran/generated/maxloc1_4_i16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_4_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_4_i16 (gfc_array_i4 * const rest *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_4_i16 (gfc_array_i4 * const res *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_4_i16 (gfc_array_i4 * const res *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_4_i2.c gcc-4.4.0/libgfortran/generated/maxloc1_4_i2.c *** gcc-4.3.3/libgfortran/generated/maxloc1_4_i2.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_4_i2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_4_i2 (gfc_array_i4 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_4_i2 (gfc_array_i4 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_4_i2 (gfc_array_i4 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_4_i4.c gcc-4.4.0/libgfortran/generated/maxloc1_4_i4.c *** gcc-4.3.3/libgfortran/generated/maxloc1_4_i4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_4_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_4_i4 (gfc_array_i4 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_4_i4 (gfc_array_i4 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_4_i4 (gfc_array_i4 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_4_i8.c gcc-4.4.0/libgfortran/generated/maxloc1_4_i8.c *** gcc-4.3.3/libgfortran/generated/maxloc1_4_i8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_4_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_4_i8 (gfc_array_i4 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_4_i8 (gfc_array_i4 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_4_i8 (gfc_array_i4 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_4_r10.c gcc-4.4.0/libgfortran/generated/maxloc1_4_r10.c *** gcc-4.3.3/libgfortran/generated/maxloc1_4_r10.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_4_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_4_r10 (gfc_array_i4 * const rest *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_4_r10 (gfc_array_i4 * const res *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_4_r10 (gfc_array_i4 * const res *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_4_r16.c gcc-4.4.0/libgfortran/generated/maxloc1_4_r16.c *** gcc-4.3.3/libgfortran/generated/maxloc1_4_r16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_4_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_4_r16 (gfc_array_i4 * const rest *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_4_r16 (gfc_array_i4 * const res *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_4_r16 (gfc_array_i4 * const res *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_4_r4.c gcc-4.4.0/libgfortran/generated/maxloc1_4_r4.c *** gcc-4.3.3/libgfortran/generated/maxloc1_4_r4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_4_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_4_r4 (gfc_array_i4 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_4_r4 (gfc_array_i4 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_4_r4 (gfc_array_i4 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_4_r8.c gcc-4.4.0/libgfortran/generated/maxloc1_4_r8.c *** gcc-4.3.3/libgfortran/generated/maxloc1_4_r8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_4_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_4_r8 (gfc_array_i4 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_4_r8 (gfc_array_i4 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_4_r8 (gfc_array_i4 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_8_i1.c gcc-4.4.0/libgfortran/generated/maxloc1_8_i1.c *** gcc-4.3.3/libgfortran/generated/maxloc1_8_i1.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_8_i1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_8_i1 (gfc_array_i8 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_8_i1 (gfc_array_i8 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_8_i1 (gfc_array_i8 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_8_i16.c gcc-4.4.0/libgfortran/generated/maxloc1_8_i16.c *** gcc-4.3.3/libgfortran/generated/maxloc1_8_i16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_8_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_8_i16 (gfc_array_i8 * const rest *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_8_i16 (gfc_array_i8 * const res *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_8_i16 (gfc_array_i8 * const res *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_8_i2.c gcc-4.4.0/libgfortran/generated/maxloc1_8_i2.c *** gcc-4.3.3/libgfortran/generated/maxloc1_8_i2.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_8_i2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_8_i2 (gfc_array_i8 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_8_i2 (gfc_array_i8 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_8_i2 (gfc_array_i8 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_8_i4.c gcc-4.4.0/libgfortran/generated/maxloc1_8_i4.c *** gcc-4.3.3/libgfortran/generated/maxloc1_8_i4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_8_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_8_i4 (gfc_array_i8 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_8_i4 (gfc_array_i8 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_8_i4 (gfc_array_i8 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_8_i8.c gcc-4.4.0/libgfortran/generated/maxloc1_8_i8.c *** gcc-4.3.3/libgfortran/generated/maxloc1_8_i8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_8_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_8_i8 (gfc_array_i8 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_8_i8 (gfc_array_i8 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_8_i8 (gfc_array_i8 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_8_r10.c gcc-4.4.0/libgfortran/generated/maxloc1_8_r10.c *** gcc-4.3.3/libgfortran/generated/maxloc1_8_r10.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_8_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_8_r10 (gfc_array_i8 * const rest *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_8_r10 (gfc_array_i8 * const res *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_8_r10 (gfc_array_i8 * const res *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_8_r16.c gcc-4.4.0/libgfortran/generated/maxloc1_8_r16.c *** gcc-4.3.3/libgfortran/generated/maxloc1_8_r16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_8_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_8_r16 (gfc_array_i8 * const rest *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_8_r16 (gfc_array_i8 * const res *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_8_r16 (gfc_array_i8 * const res *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_8_r4.c gcc-4.4.0/libgfortran/generated/maxloc1_8_r4.c *** gcc-4.3.3/libgfortran/generated/maxloc1_8_r4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_8_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_8_r4 (gfc_array_i8 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_8_r4 (gfc_array_i8 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_8_r4 (gfc_array_i8 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxloc1_8_r8.c gcc-4.4.0/libgfortran/generated/maxloc1_8_r8.c *** gcc-4.3.3/libgfortran/generated/maxloc1_8_r8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxloc1_8_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxloc1_8_r8 (gfc_array_i8 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxloc1_8_r8 (gfc_array_i8 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxloc1_8_r8 (gfc_array_i8 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxval_i1.c gcc-4.4.0/libgfortran/generated/maxval_i1.c *** gcc-4.3.3/libgfortran/generated/maxval_i1.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxval_i1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxval_i1 (gfc_array_i1 * const restrict *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxval_i1 (gfc_array_i1 * const restric *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxval_i1 (gfc_array_i1 * const restric *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxval_i16.c gcc-4.4.0/libgfortran/generated/maxval_i16.c *** gcc-4.3.3/libgfortran/generated/maxval_i16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxval_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxval_i16 (gfc_array_i16 * const restri *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxval_i16 (gfc_array_i16 * const restr *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxval_i16 (gfc_array_i16 * const restr *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxval_i2.c gcc-4.4.0/libgfortran/generated/maxval_i2.c *** gcc-4.3.3/libgfortran/generated/maxval_i2.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxval_i2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxval_i2 (gfc_array_i2 * const restrict *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxval_i2 (gfc_array_i2 * const restric *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxval_i2 (gfc_array_i2 * const restric *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxval_i4.c gcc-4.4.0/libgfortran/generated/maxval_i4.c *** gcc-4.3.3/libgfortran/generated/maxval_i4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxval_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxval_i4 (gfc_array_i4 * const restrict *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxval_i4 (gfc_array_i4 * const restric *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxval_i4 (gfc_array_i4 * const restric *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxval_i8.c gcc-4.4.0/libgfortran/generated/maxval_i8.c *** gcc-4.3.3/libgfortran/generated/maxval_i8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxval_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxval_i8 (gfc_array_i8 * const restrict *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxval_i8 (gfc_array_i8 * const restric *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxval_i8 (gfc_array_i8 * const restric *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxval_r10.c gcc-4.4.0/libgfortran/generated/maxval_r10.c *** gcc-4.3.3/libgfortran/generated/maxval_r10.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxval_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxval_r10 (gfc_array_r10 * const restri *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxval_r10 (gfc_array_r10 * const restr *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxval_r10 (gfc_array_r10 * const restr *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxval_r16.c gcc-4.4.0/libgfortran/generated/maxval_r16.c *** gcc-4.3.3/libgfortran/generated/maxval_r16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxval_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxval_r16 (gfc_array_r16 * const restri *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxval_r16 (gfc_array_r16 * const restr *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxval_r16 (gfc_array_r16 * const restr *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxval_r4.c gcc-4.4.0/libgfortran/generated/maxval_r4.c *** gcc-4.3.3/libgfortran/generated/maxval_r4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxval_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxval_r4 (gfc_array_r4 * const restrict *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxval_r4 (gfc_array_r4 * const restric *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxval_r4 (gfc_array_r4 * const restric *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/maxval_r8.c gcc-4.4.0/libgfortran/generated/maxval_r8.c *** gcc-4.3.3/libgfortran/generated/maxval_r8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/maxval_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** maxval_r8 (gfc_array_r8 * const restrict *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mmaxval_r8 (gfc_array_r8 * const restric *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** smaxval_r8 (gfc_array_r8 * const restric *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_16_i1.c gcc-4.4.0/libgfortran/generated/minloc0_16_i1.c *** gcc-4.3.3/libgfortran/generated/minloc0_16_i1.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_16_i1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_16_i1 (gfc_array_i16 * const res *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_1 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_1 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** minloc0_16_i1 (gfc_array_i16 * const res *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_16_i1 (gfc_array_i16 * const re *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_16_i1 (gfc_array_i16 * const re *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_16_i16.c gcc-4.4.0/libgfortran/generated/minloc0_16_i16.c *** gcc-4.3.3/libgfortran/generated/minloc0_16_i16.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_16_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_16_i16 (gfc_array_i16 * const re *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_16 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_16 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** minloc0_16_i16 (gfc_array_i16 * const re *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_16_i16 (gfc_array_i16 * const r *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_16_i16 (gfc_array_i16 * const r *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_16_i2.c gcc-4.4.0/libgfortran/generated/minloc0_16_i2.c *** gcc-4.3.3/libgfortran/generated/minloc0_16_i2.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_16_i2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_16_i2 (gfc_array_i16 * const res *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_2 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_2 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** minloc0_16_i2 (gfc_array_i16 * const res *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_16_i2 (gfc_array_i16 * const re *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_16_i2 (gfc_array_i16 * const re *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_16_i4.c gcc-4.4.0/libgfortran/generated/minloc0_16_i4.c *** gcc-4.3.3/libgfortran/generated/minloc0_16_i4.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_16_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_16_i4 (gfc_array_i16 * const res *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_4 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_4 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** minloc0_16_i4 (gfc_array_i16 * const res *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_16_i4 (gfc_array_i16 * const re *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_16_i4 (gfc_array_i16 * const re *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_16_i8.c gcc-4.4.0/libgfortran/generated/minloc0_16_i8.c *** gcc-4.3.3/libgfortran/generated/minloc0_16_i8.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_16_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_16_i8 (gfc_array_i16 * const res *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_8 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_8 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** minloc0_16_i8 (gfc_array_i16 * const res *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_16_i8 (gfc_array_i16 * const re *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_16_i8 (gfc_array_i16 * const re *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_16_r10.c gcc-4.4.0/libgfortran/generated/minloc0_16_r10.c *** gcc-4.3.3/libgfortran/generated/minloc0_16_r10.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_16_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_16_r10 (gfc_array_i16 * const re *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_10 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_10 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** minloc0_16_r10 (gfc_array_i16 * const re *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_16_r10 (gfc_array_i16 * const r *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_16_r10 (gfc_array_i16 * const r *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_16_r16.c gcc-4.4.0/libgfortran/generated/minloc0_16_r16.c *** gcc-4.3.3/libgfortran/generated/minloc0_16_r16.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_16_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_16_r16 (gfc_array_i16 * const re *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_16 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_16 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** minloc0_16_r16 (gfc_array_i16 * const re *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_16_r16 (gfc_array_i16 * const r *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_16_r16 (gfc_array_i16 * const r *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_16_r4.c gcc-4.4.0/libgfortran/generated/minloc0_16_r4.c *** gcc-4.3.3/libgfortran/generated/minloc0_16_r4.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_16_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_16_r4 (gfc_array_i16 * const res *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_4 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_4 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** minloc0_16_r4 (gfc_array_i16 * const res *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_16_r4 (gfc_array_i16 * const re *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_16_r4 (gfc_array_i16 * const re *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_16_r8.c gcc-4.4.0/libgfortran/generated/minloc0_16_r8.c *** gcc-4.3.3/libgfortran/generated/minloc0_16_r8.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_16_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_16_r8 (gfc_array_i16 * const res *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_8 *base; ! GFC_INTEGER_16 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_8 *base; ! GFC_INTEGER_16 * restrict dest; index_type rank; index_type n; *************** minloc0_16_r8 (gfc_array_i16 * const res *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_16_r8 (gfc_array_i16 * const re *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_16_r8 (gfc_array_i16 * const re *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_4_i1.c gcc-4.4.0/libgfortran/generated/minloc0_4_i1.c *** gcc-4.3.3/libgfortran/generated/minloc0_4_i1.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_4_i1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_4_i1 (gfc_array_i4 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_1 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_1 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** minloc0_4_i1 (gfc_array_i4 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_4_i1 (gfc_array_i4 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_4_i1 (gfc_array_i4 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_4_i16.c gcc-4.4.0/libgfortran/generated/minloc0_4_i16.c *** gcc-4.3.3/libgfortran/generated/minloc0_4_i16.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_4_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_4_i16 (gfc_array_i4 * const rest *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_16 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_16 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** minloc0_4_i16 (gfc_array_i4 * const rest *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_4_i16 (gfc_array_i4 * const res *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_4_i16 (gfc_array_i4 * const res *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_4_i2.c gcc-4.4.0/libgfortran/generated/minloc0_4_i2.c *** gcc-4.3.3/libgfortran/generated/minloc0_4_i2.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_4_i2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_4_i2 (gfc_array_i4 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_2 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_2 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** minloc0_4_i2 (gfc_array_i4 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_4_i2 (gfc_array_i4 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_4_i2 (gfc_array_i4 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_4_i4.c gcc-4.4.0/libgfortran/generated/minloc0_4_i4.c *** gcc-4.3.3/libgfortran/generated/minloc0_4_i4.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_4_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_4_i4 (gfc_array_i4 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_4 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_4 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** minloc0_4_i4 (gfc_array_i4 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_4_i4 (gfc_array_i4 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_4_i4 (gfc_array_i4 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_4_i8.c gcc-4.4.0/libgfortran/generated/minloc0_4_i8.c *** gcc-4.3.3/libgfortran/generated/minloc0_4_i8.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_4_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_4_i8 (gfc_array_i4 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_8 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_8 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** minloc0_4_i8 (gfc_array_i4 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_4_i8 (gfc_array_i4 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_4_i8 (gfc_array_i4 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_4_r10.c gcc-4.4.0/libgfortran/generated/minloc0_4_r10.c *** gcc-4.3.3/libgfortran/generated/minloc0_4_r10.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_4_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_4_r10 (gfc_array_i4 * const rest *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_10 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_10 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** minloc0_4_r10 (gfc_array_i4 * const rest *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_4_r10 (gfc_array_i4 * const res *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_4_r10 (gfc_array_i4 * const res *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_4_r16.c gcc-4.4.0/libgfortran/generated/minloc0_4_r16.c *** gcc-4.3.3/libgfortran/generated/minloc0_4_r16.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_4_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_4_r16 (gfc_array_i4 * const rest *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_16 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_16 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** minloc0_4_r16 (gfc_array_i4 * const rest *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_4_r16 (gfc_array_i4 * const res *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_4_r16 (gfc_array_i4 * const res *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_4_r4.c gcc-4.4.0/libgfortran/generated/minloc0_4_r4.c *** gcc-4.3.3/libgfortran/generated/minloc0_4_r4.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_4_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_4_r4 (gfc_array_i4 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_4 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_4 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** minloc0_4_r4 (gfc_array_i4 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_4_r4 (gfc_array_i4 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_4_r4 (gfc_array_i4 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_4_r8.c gcc-4.4.0/libgfortran/generated/minloc0_4_r8.c *** gcc-4.3.3/libgfortran/generated/minloc0_4_r8.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_4_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_4_r8 (gfc_array_i4 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_8 *base; ! GFC_INTEGER_4 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_8 *base; ! GFC_INTEGER_4 * restrict dest; index_type rank; index_type n; *************** minloc0_4_r8 (gfc_array_i4 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_4_r8 (gfc_array_i4 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_4_r8 (gfc_array_i4 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_8_i1.c gcc-4.4.0/libgfortran/generated/minloc0_8_i1.c *** gcc-4.3.3/libgfortran/generated/minloc0_8_i1.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_8_i1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_8_i1 (gfc_array_i8 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_1 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_1 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** minloc0_8_i1 (gfc_array_i8 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_8_i1 (gfc_array_i8 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_8_i1 (gfc_array_i8 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_8_i16.c gcc-4.4.0/libgfortran/generated/minloc0_8_i16.c *** gcc-4.3.3/libgfortran/generated/minloc0_8_i16.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_8_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_8_i16 (gfc_array_i8 * const rest *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_16 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_16 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** minloc0_8_i16 (gfc_array_i8 * const rest *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_8_i16 (gfc_array_i8 * const res *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_8_i16 (gfc_array_i8 * const res *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_8_i2.c gcc-4.4.0/libgfortran/generated/minloc0_8_i2.c *** gcc-4.3.3/libgfortran/generated/minloc0_8_i2.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_8_i2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_8_i2 (gfc_array_i8 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_2 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_2 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** minloc0_8_i2 (gfc_array_i8 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_8_i2 (gfc_array_i8 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_8_i2 (gfc_array_i8 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_8_i4.c gcc-4.4.0/libgfortran/generated/minloc0_8_i4.c *** gcc-4.3.3/libgfortran/generated/minloc0_8_i4.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_8_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_8_i4 (gfc_array_i8 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_4 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_4 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** minloc0_8_i4 (gfc_array_i8 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_8_i4 (gfc_array_i8 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_8_i4 (gfc_array_i8 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_8_i8.c gcc-4.4.0/libgfortran/generated/minloc0_8_i8.c *** gcc-4.3.3/libgfortran/generated/minloc0_8_i8.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_8_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_8_i8 (gfc_array_i8 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_8 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_INTEGER_8 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** minloc0_8_i8 (gfc_array_i8 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_8_i8 (gfc_array_i8 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_8_i8 (gfc_array_i8 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_8_r10.c gcc-4.4.0/libgfortran/generated/minloc0_8_r10.c *** gcc-4.3.3/libgfortran/generated/minloc0_8_r10.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_8_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_8_r10 (gfc_array_i8 * const rest *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_10 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_10 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** minloc0_8_r10 (gfc_array_i8 * const rest *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_8_r10 (gfc_array_i8 * const res *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_8_r10 (gfc_array_i8 * const res *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_8_r16.c gcc-4.4.0/libgfortran/generated/minloc0_8_r16.c *** gcc-4.3.3/libgfortran/generated/minloc0_8_r16.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_8_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_8_r16 (gfc_array_i8 * const rest *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_16 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_16 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** minloc0_8_r16 (gfc_array_i8 * const rest *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_8_r16 (gfc_array_i8 * const res *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_8_r16 (gfc_array_i8 * const res *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_8_r4.c gcc-4.4.0/libgfortran/generated/minloc0_8_r4.c *** gcc-4.3.3/libgfortran/generated/minloc0_8_r4.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_8_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_8_r4 (gfc_array_i8 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_4 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_4 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** minloc0_8_r4 (gfc_array_i8 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_8_r4 (gfc_array_i8 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_8_r4 (gfc_array_i8 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc0_8_r8.c gcc-4.4.0/libgfortran/generated/minloc0_8_r8.c *** gcc-4.3.3/libgfortran/generated/minloc0_8_r8.c Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/generated/minloc0_8_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc0_8_r8 (gfc_array_i8 * const restr *** 50,56 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_8 *base; ! GFC_INTEGER_8 *dest; index_type rank; index_type n; --- 45,51 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_8 *base; ! GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; *************** minloc0_8_r8 (gfc_array_i8 * const restr *** 69,75 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 64,70 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** mminloc0_8_r8 (gfc_array_i8 * const rest *** 193,199 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 188,194 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** sminloc0_8_r8 (gfc_array_i8 * const rest *** 353,359 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 348,354 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_16_i1.c gcc-4.4.0/libgfortran/generated/minloc1_16_i1.c *** gcc-4.3.3/libgfortran/generated/minloc1_16_i1.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_16_i1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_16_i1 (gfc_array_i16 * const res *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_16_i1 (gfc_array_i16 * const re *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_16_i1 (gfc_array_i16 * const re *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_16_i16.c gcc-4.4.0/libgfortran/generated/minloc1_16_i16.c *** gcc-4.3.3/libgfortran/generated/minloc1_16_i16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_16_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_16_i16 (gfc_array_i16 * const re *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_16_i16 (gfc_array_i16 * const r *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_16_i16 (gfc_array_i16 * const r *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_16_i2.c gcc-4.4.0/libgfortran/generated/minloc1_16_i2.c *** gcc-4.3.3/libgfortran/generated/minloc1_16_i2.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_16_i2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_16_i2 (gfc_array_i16 * const res *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_16_i2 (gfc_array_i16 * const re *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_16_i2 (gfc_array_i16 * const re *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_16_i4.c gcc-4.4.0/libgfortran/generated/minloc1_16_i4.c *** gcc-4.3.3/libgfortran/generated/minloc1_16_i4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_16_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_16_i4 (gfc_array_i16 * const res *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_16_i4 (gfc_array_i16 * const re *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_16_i4 (gfc_array_i16 * const re *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_16_i8.c gcc-4.4.0/libgfortran/generated/minloc1_16_i8.c *** gcc-4.3.3/libgfortran/generated/minloc1_16_i8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_16_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_16_i8 (gfc_array_i16 * const res *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_16_i8 (gfc_array_i16 * const re *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_16_i8 (gfc_array_i16 * const re *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_16_r10.c gcc-4.4.0/libgfortran/generated/minloc1_16_r10.c *** gcc-4.3.3/libgfortran/generated/minloc1_16_r10.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_16_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_16_r10 (gfc_array_i16 * const re *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_16_r10 (gfc_array_i16 * const r *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_16_r10 (gfc_array_i16 * const r *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_16_r16.c gcc-4.4.0/libgfortran/generated/minloc1_16_r16.c *** gcc-4.3.3/libgfortran/generated/minloc1_16_r16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_16_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_16_r16 (gfc_array_i16 * const re *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_16_r16 (gfc_array_i16 * const r *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_16_r16 (gfc_array_i16 * const r *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_16_r4.c gcc-4.4.0/libgfortran/generated/minloc1_16_r4.c *** gcc-4.3.3/libgfortran/generated/minloc1_16_r4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_16_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_16_r4 (gfc_array_i16 * const res *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_16_r4 (gfc_array_i16 * const re *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_16_r4 (gfc_array_i16 * const re *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_16_r8.c gcc-4.4.0/libgfortran/generated/minloc1_16_r8.c *** gcc-4.3.3/libgfortran/generated/minloc1_16_r8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_16_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_16_r8 (gfc_array_i16 * const res *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_16_r8 (gfc_array_i16 * const re *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_16_r8 (gfc_array_i16 * const re *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_4_i1.c gcc-4.4.0/libgfortran/generated/minloc1_4_i1.c *** gcc-4.3.3/libgfortran/generated/minloc1_4_i1.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_4_i1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_4_i1 (gfc_array_i4 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_4_i1 (gfc_array_i4 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_4_i1 (gfc_array_i4 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_4_i16.c gcc-4.4.0/libgfortran/generated/minloc1_4_i16.c *** gcc-4.3.3/libgfortran/generated/minloc1_4_i16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_4_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_4_i16 (gfc_array_i4 * const rest *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_4_i16 (gfc_array_i4 * const res *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_4_i16 (gfc_array_i4 * const res *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_4_i2.c gcc-4.4.0/libgfortran/generated/minloc1_4_i2.c *** gcc-4.3.3/libgfortran/generated/minloc1_4_i2.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_4_i2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_4_i2 (gfc_array_i4 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_4_i2 (gfc_array_i4 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_4_i2 (gfc_array_i4 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_4_i4.c gcc-4.4.0/libgfortran/generated/minloc1_4_i4.c *** gcc-4.3.3/libgfortran/generated/minloc1_4_i4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_4_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_4_i4 (gfc_array_i4 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_4_i4 (gfc_array_i4 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_4_i4 (gfc_array_i4 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_4_i8.c gcc-4.4.0/libgfortran/generated/minloc1_4_i8.c *** gcc-4.3.3/libgfortran/generated/minloc1_4_i8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_4_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_4_i8 (gfc_array_i4 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_4_i8 (gfc_array_i4 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_4_i8 (gfc_array_i4 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_4_r10.c gcc-4.4.0/libgfortran/generated/minloc1_4_r10.c *** gcc-4.3.3/libgfortran/generated/minloc1_4_r10.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_4_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_4_r10 (gfc_array_i4 * const rest *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_4_r10 (gfc_array_i4 * const res *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_4_r10 (gfc_array_i4 * const res *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_4_r16.c gcc-4.4.0/libgfortran/generated/minloc1_4_r16.c *** gcc-4.3.3/libgfortran/generated/minloc1_4_r16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_4_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_4_r16 (gfc_array_i4 * const rest *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_4_r16 (gfc_array_i4 * const res *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_4_r16 (gfc_array_i4 * const res *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_4_r4.c gcc-4.4.0/libgfortran/generated/minloc1_4_r4.c *** gcc-4.3.3/libgfortran/generated/minloc1_4_r4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_4_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_4_r4 (gfc_array_i4 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_4_r4 (gfc_array_i4 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_4_r4 (gfc_array_i4 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_4_r8.c gcc-4.4.0/libgfortran/generated/minloc1_4_r8.c *** gcc-4.3.3/libgfortran/generated/minloc1_4_r8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_4_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_4_r8 (gfc_array_i4 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_4_r8 (gfc_array_i4 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_4_r8 (gfc_array_i4 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_8_i1.c gcc-4.4.0/libgfortran/generated/minloc1_8_i1.c *** gcc-4.3.3/libgfortran/generated/minloc1_8_i1.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_8_i1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_8_i1 (gfc_array_i8 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_8_i1 (gfc_array_i8 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_8_i1 (gfc_array_i8 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_8_i16.c gcc-4.4.0/libgfortran/generated/minloc1_8_i16.c *** gcc-4.3.3/libgfortran/generated/minloc1_8_i16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_8_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_8_i16 (gfc_array_i8 * const rest *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_8_i16 (gfc_array_i8 * const res *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_8_i16 (gfc_array_i8 * const res *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_8_i2.c gcc-4.4.0/libgfortran/generated/minloc1_8_i2.c *** gcc-4.3.3/libgfortran/generated/minloc1_8_i2.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_8_i2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_8_i2 (gfc_array_i8 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_8_i2 (gfc_array_i8 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_8_i2 (gfc_array_i8 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_8_i4.c gcc-4.4.0/libgfortran/generated/minloc1_8_i4.c *** gcc-4.3.3/libgfortran/generated/minloc1_8_i4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_8_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_8_i4 (gfc_array_i8 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_8_i4 (gfc_array_i8 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_8_i4 (gfc_array_i8 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_8_i8.c gcc-4.4.0/libgfortran/generated/minloc1_8_i8.c *** gcc-4.3.3/libgfortran/generated/minloc1_8_i8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_8_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_8_i8 (gfc_array_i8 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_8_i8 (gfc_array_i8 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_8_i8 (gfc_array_i8 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_8_r10.c gcc-4.4.0/libgfortran/generated/minloc1_8_r10.c *** gcc-4.3.3/libgfortran/generated/minloc1_8_r10.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_8_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_8_r10 (gfc_array_i8 * const rest *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_8_r10 (gfc_array_i8 * const res *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_8_r10 (gfc_array_i8 * const res *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_8_r16.c gcc-4.4.0/libgfortran/generated/minloc1_8_r16.c *** gcc-4.3.3/libgfortran/generated/minloc1_8_r16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_8_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_8_r16 (gfc_array_i8 * const rest *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_8_r16 (gfc_array_i8 * const res *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_8_r16 (gfc_array_i8 * const res *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_8_r4.c gcc-4.4.0/libgfortran/generated/minloc1_8_r4.c *** gcc-4.3.3/libgfortran/generated/minloc1_8_r4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_8_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_8_r4 (gfc_array_i8 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_8_r4 (gfc_array_i8 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_8_r4 (gfc_array_i8 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minloc1_8_r8.c gcc-4.4.0/libgfortran/generated/minloc1_8_r8.c *** gcc-4.3.3/libgfortran/generated/minloc1_8_r8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minloc1_8_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minloc1_8_r8 (gfc_array_i8 * const restr *** 124,130 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 119,125 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminloc1_8_r8 (gfc_array_i8 * const rest *** 318,324 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 313,319 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINLOC intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminloc1_8_r8 (gfc_array_i8 * const rest *** 508,514 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 503,509 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minval_i1.c gcc-4.4.0/libgfortran/generated/minval_i1.c *** gcc-4.3.3/libgfortran/generated/minval_i1.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minval_i1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minval_i1 (gfc_array_i1 * const restrict *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminval_i1 (gfc_array_i1 * const restric *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminval_i1 (gfc_array_i1 * const restric *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minval_i16.c gcc-4.4.0/libgfortran/generated/minval_i16.c *** gcc-4.3.3/libgfortran/generated/minval_i16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minval_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minval_i16 (gfc_array_i16 * const restri *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminval_i16 (gfc_array_i16 * const restr *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminval_i16 (gfc_array_i16 * const restr *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minval_i2.c gcc-4.4.0/libgfortran/generated/minval_i2.c *** gcc-4.3.3/libgfortran/generated/minval_i2.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minval_i2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minval_i2 (gfc_array_i2 * const restrict *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminval_i2 (gfc_array_i2 * const restric *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminval_i2 (gfc_array_i2 * const restric *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minval_i4.c gcc-4.4.0/libgfortran/generated/minval_i4.c *** gcc-4.3.3/libgfortran/generated/minval_i4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minval_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minval_i4 (gfc_array_i4 * const restrict *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminval_i4 (gfc_array_i4 * const restric *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminval_i4 (gfc_array_i4 * const restric *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minval_i8.c gcc-4.4.0/libgfortran/generated/minval_i8.c *** gcc-4.3.3/libgfortran/generated/minval_i8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minval_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minval_i8 (gfc_array_i8 * const restrict *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminval_i8 (gfc_array_i8 * const restric *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminval_i8 (gfc_array_i8 * const restric *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minval_r10.c gcc-4.4.0/libgfortran/generated/minval_r10.c *** gcc-4.3.3/libgfortran/generated/minval_r10.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minval_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minval_r10 (gfc_array_r10 * const restri *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminval_r10 (gfc_array_r10 * const restr *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminval_r10 (gfc_array_r10 * const restr *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minval_r16.c gcc-4.4.0/libgfortran/generated/minval_r16.c *** gcc-4.3.3/libgfortran/generated/minval_r16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minval_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minval_r16 (gfc_array_r16 * const restri *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminval_r16 (gfc_array_r16 * const restr *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminval_r16 (gfc_array_r16 * const restr *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minval_r4.c gcc-4.4.0/libgfortran/generated/minval_r4.c *** gcc-4.3.3/libgfortran/generated/minval_r4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minval_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minval_r4 (gfc_array_r4 * const restrict *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminval_r4 (gfc_array_r4 * const restric *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminval_r4 (gfc_array_r4 * const restric *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/minval_r8.c gcc-4.4.0/libgfortran/generated/minval_r8.c *** gcc-4.3.3/libgfortran/generated/minval_r8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/minval_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** minval_r8 (gfc_array_r8 * const restrict *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mminval_r8 (gfc_array_r8 * const restric *** 312,318 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 307,313 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in MINVAL intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sminval_r8 (gfc_array_r8 * const restric *** 497,503 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 492,498 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/misc_specifics.F90 gcc-4.4.0/libgfortran/generated/misc_specifics.F90 *** gcc-4.3.3/libgfortran/generated/misc_specifics.F90 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/misc_specifics.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,31 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated. --- 6,26 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated. diff -Nrcpad gcc-4.3.3/libgfortran/generated/nearest_r10.c gcc-4.4.0/libgfortran/generated/nearest_r10.c *** gcc-4.3.3/libgfortran/generated/nearest_r10.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/nearest_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the NEAREST intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the NEAREST intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/nearest_r16.c gcc-4.4.0/libgfortran/generated/nearest_r16.c *** gcc-4.3.3/libgfortran/generated/nearest_r16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/nearest_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the NEAREST intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the NEAREST intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/nearest_r4.c gcc-4.4.0/libgfortran/generated/nearest_r4.c *** gcc-4.3.3/libgfortran/generated/nearest_r4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/nearest_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the NEAREST intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the NEAREST intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/nearest_r8.c gcc-4.4.0/libgfortran/generated/nearest_r8.c *** gcc-4.3.3/libgfortran/generated/nearest_r8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/nearest_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the NEAREST intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the NEAREST intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pack_c10.c gcc-4.4.0/libgfortran/generated/pack_c10.c *** gcc-4.3.3/libgfortran/generated/pack_c10.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/pack_c10.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,315 ---- + /* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_COMPLEX_10) + + /* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + + There are two variants of the PACK intrinsic: one, where MASK is + array valued, and the other one where MASK is scalar. */ + + void + pack_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, + const gfc_array_l1 *mask, const gfc_array_c10 *vector) + { + /* r.* indicates the return array. */ + index_type rstride0; + GFC_COMPLEX_10 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_COMPLEX_10 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || compile_options.bounds_check) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + + /* TODO: We could speed up pack easily in the case of only + few .TRUE. entries in MASK, by keeping track of where we + would be in the source array during the initial traversal + of MASK, and caching the pointers to those elements. Then, + supposed the number of elements is small enough, we would + only have to traverse the list, and copy those elements + into the result array. In the case of datatypes which fit + in one of the integer types we could also cache the + value instead of a pointer to it. + This approach might be bad from the point of view of + cache behavior in the case where our cache is not big + enough to hold all elements that have to be copied. */ + + const GFC_LOGICAL_1 *m = mptr; + + total = 0; + if (zero_sized) + m = NULL; + + while (m) + { + /* Test this element. */ + if (*m) + total++; + + /* Advance to the next element. */ + m += mstride[0]; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it + and increment the next dimension. */ + count[n] = 0; + /* We could precalculate this product, but this is a + less frequently used path so probably not worth + it. */ + m -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + m = NULL; + break; + } + else + { + count[n]++; + m += mstride[n]; + } + } + } + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + ret->dim[0].lbound = 0; + ret->dim[0].ubound = total - 1; + ret->dim[0].stride = 1; + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_10) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = ret->dim[0].stride; + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = vector->dim[0].stride; + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/pack_c16.c gcc-4.4.0/libgfortran/generated/pack_c16.c *** gcc-4.3.3/libgfortran/generated/pack_c16.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/pack_c16.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,315 ---- + /* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_COMPLEX_16) + + /* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + + There are two variants of the PACK intrinsic: one, where MASK is + array valued, and the other one where MASK is scalar. */ + + void + pack_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, + const gfc_array_l1 *mask, const gfc_array_c16 *vector) + { + /* r.* indicates the return array. */ + index_type rstride0; + GFC_COMPLEX_16 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_COMPLEX_16 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || compile_options.bounds_check) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + + /* TODO: We could speed up pack easily in the case of only + few .TRUE. entries in MASK, by keeping track of where we + would be in the source array during the initial traversal + of MASK, and caching the pointers to those elements. Then, + supposed the number of elements is small enough, we would + only have to traverse the list, and copy those elements + into the result array. In the case of datatypes which fit + in one of the integer types we could also cache the + value instead of a pointer to it. + This approach might be bad from the point of view of + cache behavior in the case where our cache is not big + enough to hold all elements that have to be copied. */ + + const GFC_LOGICAL_1 *m = mptr; + + total = 0; + if (zero_sized) + m = NULL; + + while (m) + { + /* Test this element. */ + if (*m) + total++; + + /* Advance to the next element. */ + m += mstride[0]; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it + and increment the next dimension. */ + count[n] = 0; + /* We could precalculate this product, but this is a + less frequently used path so probably not worth + it. */ + m -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + m = NULL; + break; + } + else + { + count[n]++; + m += mstride[n]; + } + } + } + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + ret->dim[0].lbound = 0; + ret->dim[0].ubound = total - 1; + ret->dim[0].stride = 1; + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_16) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = ret->dim[0].stride; + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = vector->dim[0].stride; + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/pack_c4.c gcc-4.4.0/libgfortran/generated/pack_c4.c *** gcc-4.3.3/libgfortran/generated/pack_c4.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/pack_c4.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,315 ---- + /* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_COMPLEX_4) + + /* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + + There are two variants of the PACK intrinsic: one, where MASK is + array valued, and the other one where MASK is scalar. */ + + void + pack_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, + const gfc_array_l1 *mask, const gfc_array_c4 *vector) + { + /* r.* indicates the return array. */ + index_type rstride0; + GFC_COMPLEX_4 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_COMPLEX_4 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || compile_options.bounds_check) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + + /* TODO: We could speed up pack easily in the case of only + few .TRUE. entries in MASK, by keeping track of where we + would be in the source array during the initial traversal + of MASK, and caching the pointers to those elements. Then, + supposed the number of elements is small enough, we would + only have to traverse the list, and copy those elements + into the result array. In the case of datatypes which fit + in one of the integer types we could also cache the + value instead of a pointer to it. + This approach might be bad from the point of view of + cache behavior in the case where our cache is not big + enough to hold all elements that have to be copied. */ + + const GFC_LOGICAL_1 *m = mptr; + + total = 0; + if (zero_sized) + m = NULL; + + while (m) + { + /* Test this element. */ + if (*m) + total++; + + /* Advance to the next element. */ + m += mstride[0]; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it + and increment the next dimension. */ + count[n] = 0; + /* We could precalculate this product, but this is a + less frequently used path so probably not worth + it. */ + m -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + m = NULL; + break; + } + else + { + count[n]++; + m += mstride[n]; + } + } + } + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + ret->dim[0].lbound = 0; + ret->dim[0].ubound = total - 1; + ret->dim[0].stride = 1; + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_4) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = ret->dim[0].stride; + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = vector->dim[0].stride; + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/pack_c8.c gcc-4.4.0/libgfortran/generated/pack_c8.c *** gcc-4.3.3/libgfortran/generated/pack_c8.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/pack_c8.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,315 ---- + /* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_COMPLEX_8) + + /* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + + There are two variants of the PACK intrinsic: one, where MASK is + array valued, and the other one where MASK is scalar. */ + + void + pack_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, + const gfc_array_l1 *mask, const gfc_array_c8 *vector) + { + /* r.* indicates the return array. */ + index_type rstride0; + GFC_COMPLEX_8 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_COMPLEX_8 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || compile_options.bounds_check) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + + /* TODO: We could speed up pack easily in the case of only + few .TRUE. entries in MASK, by keeping track of where we + would be in the source array during the initial traversal + of MASK, and caching the pointers to those elements. Then, + supposed the number of elements is small enough, we would + only have to traverse the list, and copy those elements + into the result array. In the case of datatypes which fit + in one of the integer types we could also cache the + value instead of a pointer to it. + This approach might be bad from the point of view of + cache behavior in the case where our cache is not big + enough to hold all elements that have to be copied. */ + + const GFC_LOGICAL_1 *m = mptr; + + total = 0; + if (zero_sized) + m = NULL; + + while (m) + { + /* Test this element. */ + if (*m) + total++; + + /* Advance to the next element. */ + m += mstride[0]; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it + and increment the next dimension. */ + count[n] = 0; + /* We could precalculate this product, but this is a + less frequently used path so probably not worth + it. */ + m -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + m = NULL; + break; + } + else + { + count[n]++; + m += mstride[n]; + } + } + } + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + ret->dim[0].lbound = 0; + ret->dim[0].ubound = total - 1; + ret->dim[0].stride = 1; + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_8) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = ret->dim[0].stride; + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = vector->dim[0].stride; + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/pack_i1.c gcc-4.4.0/libgfortran/generated/pack_i1.c *** gcc-4.3.3/libgfortran/generated/pack_i1.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/pack_i1.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,315 ---- + /* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_1) + + /* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + + There are two variants of the PACK intrinsic: one, where MASK is + array valued, and the other one where MASK is scalar. */ + + void + pack_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, + const gfc_array_l1 *mask, const gfc_array_i1 *vector) + { + /* r.* indicates the return array. */ + index_type rstride0; + GFC_INTEGER_1 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_INTEGER_1 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || compile_options.bounds_check) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + + /* TODO: We could speed up pack easily in the case of only + few .TRUE. entries in MASK, by keeping track of where we + would be in the source array during the initial traversal + of MASK, and caching the pointers to those elements. Then, + supposed the number of elements is small enough, we would + only have to traverse the list, and copy those elements + into the result array. In the case of datatypes which fit + in one of the integer types we could also cache the + value instead of a pointer to it. + This approach might be bad from the point of view of + cache behavior in the case where our cache is not big + enough to hold all elements that have to be copied. */ + + const GFC_LOGICAL_1 *m = mptr; + + total = 0; + if (zero_sized) + m = NULL; + + while (m) + { + /* Test this element. */ + if (*m) + total++; + + /* Advance to the next element. */ + m += mstride[0]; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it + and increment the next dimension. */ + count[n] = 0; + /* We could precalculate this product, but this is a + less frequently used path so probably not worth + it. */ + m -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + m = NULL; + break; + } + else + { + count[n]++; + m += mstride[n]; + } + } + } + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + ret->dim[0].lbound = 0; + ret->dim[0].ubound = total - 1; + ret->dim[0].stride = 1; + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_1) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = ret->dim[0].stride; + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = vector->dim[0].stride; + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/pack_i16.c gcc-4.4.0/libgfortran/generated/pack_i16.c *** gcc-4.3.3/libgfortran/generated/pack_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/pack_i16.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,315 ---- + /* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_16) + + /* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + + There are two variants of the PACK intrinsic: one, where MASK is + array valued, and the other one where MASK is scalar. */ + + void + pack_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, + const gfc_array_l1 *mask, const gfc_array_i16 *vector) + { + /* r.* indicates the return array. */ + index_type rstride0; + GFC_INTEGER_16 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_INTEGER_16 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || compile_options.bounds_check) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + + /* TODO: We could speed up pack easily in the case of only + few .TRUE. entries in MASK, by keeping track of where we + would be in the source array during the initial traversal + of MASK, and caching the pointers to those elements. Then, + supposed the number of elements is small enough, we would + only have to traverse the list, and copy those elements + into the result array. In the case of datatypes which fit + in one of the integer types we could also cache the + value instead of a pointer to it. + This approach might be bad from the point of view of + cache behavior in the case where our cache is not big + enough to hold all elements that have to be copied. */ + + const GFC_LOGICAL_1 *m = mptr; + + total = 0; + if (zero_sized) + m = NULL; + + while (m) + { + /* Test this element. */ + if (*m) + total++; + + /* Advance to the next element. */ + m += mstride[0]; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it + and increment the next dimension. */ + count[n] = 0; + /* We could precalculate this product, but this is a + less frequently used path so probably not worth + it. */ + m -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + m = NULL; + break; + } + else + { + count[n]++; + m += mstride[n]; + } + } + } + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + ret->dim[0].lbound = 0; + ret->dim[0].ubound = total - 1; + ret->dim[0].stride = 1; + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = ret->dim[0].stride; + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = vector->dim[0].stride; + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/pack_i2.c gcc-4.4.0/libgfortran/generated/pack_i2.c *** gcc-4.3.3/libgfortran/generated/pack_i2.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/pack_i2.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,315 ---- + /* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_2) + + /* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + + There are two variants of the PACK intrinsic: one, where MASK is + array valued, and the other one where MASK is scalar. */ + + void + pack_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, + const gfc_array_l1 *mask, const gfc_array_i2 *vector) + { + /* r.* indicates the return array. */ + index_type rstride0; + GFC_INTEGER_2 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_INTEGER_2 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || compile_options.bounds_check) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + + /* TODO: We could speed up pack easily in the case of only + few .TRUE. entries in MASK, by keeping track of where we + would be in the source array during the initial traversal + of MASK, and caching the pointers to those elements. Then, + supposed the number of elements is small enough, we would + only have to traverse the list, and copy those elements + into the result array. In the case of datatypes which fit + in one of the integer types we could also cache the + value instead of a pointer to it. + This approach might be bad from the point of view of + cache behavior in the case where our cache is not big + enough to hold all elements that have to be copied. */ + + const GFC_LOGICAL_1 *m = mptr; + + total = 0; + if (zero_sized) + m = NULL; + + while (m) + { + /* Test this element. */ + if (*m) + total++; + + /* Advance to the next element. */ + m += mstride[0]; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it + and increment the next dimension. */ + count[n] = 0; + /* We could precalculate this product, but this is a + less frequently used path so probably not worth + it. */ + m -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + m = NULL; + break; + } + else + { + count[n]++; + m += mstride[n]; + } + } + } + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + ret->dim[0].lbound = 0; + ret->dim[0].ubound = total - 1; + ret->dim[0].stride = 1; + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_2) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = ret->dim[0].stride; + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = vector->dim[0].stride; + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/pack_i4.c gcc-4.4.0/libgfortran/generated/pack_i4.c *** gcc-4.3.3/libgfortran/generated/pack_i4.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/pack_i4.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,315 ---- + /* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_4) + + /* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + + There are two variants of the PACK intrinsic: one, where MASK is + array valued, and the other one where MASK is scalar. */ + + void + pack_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, + const gfc_array_l1 *mask, const gfc_array_i4 *vector) + { + /* r.* indicates the return array. */ + index_type rstride0; + GFC_INTEGER_4 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_INTEGER_4 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || compile_options.bounds_check) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + + /* TODO: We could speed up pack easily in the case of only + few .TRUE. entries in MASK, by keeping track of where we + would be in the source array during the initial traversal + of MASK, and caching the pointers to those elements. Then, + supposed the number of elements is small enough, we would + only have to traverse the list, and copy those elements + into the result array. In the case of datatypes which fit + in one of the integer types we could also cache the + value instead of a pointer to it. + This approach might be bad from the point of view of + cache behavior in the case where our cache is not big + enough to hold all elements that have to be copied. */ + + const GFC_LOGICAL_1 *m = mptr; + + total = 0; + if (zero_sized) + m = NULL; + + while (m) + { + /* Test this element. */ + if (*m) + total++; + + /* Advance to the next element. */ + m += mstride[0]; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it + and increment the next dimension. */ + count[n] = 0; + /* We could precalculate this product, but this is a + less frequently used path so probably not worth + it. */ + m -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + m = NULL; + break; + } + else + { + count[n]++; + m += mstride[n]; + } + } + } + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + ret->dim[0].lbound = 0; + ret->dim[0].ubound = total - 1; + ret->dim[0].stride = 1; + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = ret->dim[0].stride; + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = vector->dim[0].stride; + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/pack_i8.c gcc-4.4.0/libgfortran/generated/pack_i8.c *** gcc-4.3.3/libgfortran/generated/pack_i8.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/pack_i8.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,315 ---- + /* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_8) + + /* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + + There are two variants of the PACK intrinsic: one, where MASK is + array valued, and the other one where MASK is scalar. */ + + void + pack_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, + const gfc_array_l1 *mask, const gfc_array_i8 *vector) + { + /* r.* indicates the return array. */ + index_type rstride0; + GFC_INTEGER_8 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_INTEGER_8 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || compile_options.bounds_check) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + + /* TODO: We could speed up pack easily in the case of only + few .TRUE. entries in MASK, by keeping track of where we + would be in the source array during the initial traversal + of MASK, and caching the pointers to those elements. Then, + supposed the number of elements is small enough, we would + only have to traverse the list, and copy those elements + into the result array. In the case of datatypes which fit + in one of the integer types we could also cache the + value instead of a pointer to it. + This approach might be bad from the point of view of + cache behavior in the case where our cache is not big + enough to hold all elements that have to be copied. */ + + const GFC_LOGICAL_1 *m = mptr; + + total = 0; + if (zero_sized) + m = NULL; + + while (m) + { + /* Test this element. */ + if (*m) + total++; + + /* Advance to the next element. */ + m += mstride[0]; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it + and increment the next dimension. */ + count[n] = 0; + /* We could precalculate this product, but this is a + less frequently used path so probably not worth + it. */ + m -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + m = NULL; + break; + } + else + { + count[n]++; + m += mstride[n]; + } + } + } + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + ret->dim[0].lbound = 0; + ret->dim[0].ubound = total - 1; + ret->dim[0].stride = 1; + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = ret->dim[0].stride; + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = vector->dim[0].stride; + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/pack_r10.c gcc-4.4.0/libgfortran/generated/pack_r10.c *** gcc-4.3.3/libgfortran/generated/pack_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/pack_r10.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,315 ---- + /* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_10) + + /* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + + There are two variants of the PACK intrinsic: one, where MASK is + array valued, and the other one where MASK is scalar. */ + + void + pack_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, + const gfc_array_l1 *mask, const gfc_array_r10 *vector) + { + /* r.* indicates the return array. */ + index_type rstride0; + GFC_REAL_10 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_REAL_10 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || compile_options.bounds_check) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + + /* TODO: We could speed up pack easily in the case of only + few .TRUE. entries in MASK, by keeping track of where we + would be in the source array during the initial traversal + of MASK, and caching the pointers to those elements. Then, + supposed the number of elements is small enough, we would + only have to traverse the list, and copy those elements + into the result array. In the case of datatypes which fit + in one of the integer types we could also cache the + value instead of a pointer to it. + This approach might be bad from the point of view of + cache behavior in the case where our cache is not big + enough to hold all elements that have to be copied. */ + + const GFC_LOGICAL_1 *m = mptr; + + total = 0; + if (zero_sized) + m = NULL; + + while (m) + { + /* Test this element. */ + if (*m) + total++; + + /* Advance to the next element. */ + m += mstride[0]; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it + and increment the next dimension. */ + count[n] = 0; + /* We could precalculate this product, but this is a + less frequently used path so probably not worth + it. */ + m -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + m = NULL; + break; + } + else + { + count[n]++; + m += mstride[n]; + } + } + } + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + ret->dim[0].lbound = 0; + ret->dim[0].ubound = total - 1; + ret->dim[0].stride = 1; + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_REAL_10) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = ret->dim[0].stride; + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = vector->dim[0].stride; + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/pack_r16.c gcc-4.4.0/libgfortran/generated/pack_r16.c *** gcc-4.3.3/libgfortran/generated/pack_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/pack_r16.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,315 ---- + /* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_16) + + /* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + + There are two variants of the PACK intrinsic: one, where MASK is + array valued, and the other one where MASK is scalar. */ + + void + pack_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, + const gfc_array_l1 *mask, const gfc_array_r16 *vector) + { + /* r.* indicates the return array. */ + index_type rstride0; + GFC_REAL_16 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_REAL_16 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || compile_options.bounds_check) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + + /* TODO: We could speed up pack easily in the case of only + few .TRUE. entries in MASK, by keeping track of where we + would be in the source array during the initial traversal + of MASK, and caching the pointers to those elements. Then, + supposed the number of elements is small enough, we would + only have to traverse the list, and copy those elements + into the result array. In the case of datatypes which fit + in one of the integer types we could also cache the + value instead of a pointer to it. + This approach might be bad from the point of view of + cache behavior in the case where our cache is not big + enough to hold all elements that have to be copied. */ + + const GFC_LOGICAL_1 *m = mptr; + + total = 0; + if (zero_sized) + m = NULL; + + while (m) + { + /* Test this element. */ + if (*m) + total++; + + /* Advance to the next element. */ + m += mstride[0]; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it + and increment the next dimension. */ + count[n] = 0; + /* We could precalculate this product, but this is a + less frequently used path so probably not worth + it. */ + m -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + m = NULL; + break; + } + else + { + count[n]++; + m += mstride[n]; + } + } + } + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + ret->dim[0].lbound = 0; + ret->dim[0].ubound = total - 1; + ret->dim[0].stride = 1; + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_REAL_16) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = ret->dim[0].stride; + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = vector->dim[0].stride; + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/pack_r4.c gcc-4.4.0/libgfortran/generated/pack_r4.c *** gcc-4.3.3/libgfortran/generated/pack_r4.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/pack_r4.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,315 ---- + /* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_4) + + /* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + + There are two variants of the PACK intrinsic: one, where MASK is + array valued, and the other one where MASK is scalar. */ + + void + pack_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, + const gfc_array_l1 *mask, const gfc_array_r4 *vector) + { + /* r.* indicates the return array. */ + index_type rstride0; + GFC_REAL_4 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_REAL_4 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || compile_options.bounds_check) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + + /* TODO: We could speed up pack easily in the case of only + few .TRUE. entries in MASK, by keeping track of where we + would be in the source array during the initial traversal + of MASK, and caching the pointers to those elements. Then, + supposed the number of elements is small enough, we would + only have to traverse the list, and copy those elements + into the result array. In the case of datatypes which fit + in one of the integer types we could also cache the + value instead of a pointer to it. + This approach might be bad from the point of view of + cache behavior in the case where our cache is not big + enough to hold all elements that have to be copied. */ + + const GFC_LOGICAL_1 *m = mptr; + + total = 0; + if (zero_sized) + m = NULL; + + while (m) + { + /* Test this element. */ + if (*m) + total++; + + /* Advance to the next element. */ + m += mstride[0]; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it + and increment the next dimension. */ + count[n] = 0; + /* We could precalculate this product, but this is a + less frequently used path so probably not worth + it. */ + m -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + m = NULL; + break; + } + else + { + count[n]++; + m += mstride[n]; + } + } + } + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + ret->dim[0].lbound = 0; + ret->dim[0].ubound = total - 1; + ret->dim[0].stride = 1; + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_REAL_4) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = ret->dim[0].stride; + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = vector->dim[0].stride; + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/pack_r8.c gcc-4.4.0/libgfortran/generated/pack_r8.c *** gcc-4.3.3/libgfortran/generated/pack_r8.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/pack_r8.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,315 ---- + /* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_8) + + /* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + + There are two variants of the PACK intrinsic: one, where MASK is + array valued, and the other one where MASK is scalar. */ + + void + pack_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, + const gfc_array_l1 *mask, const gfc_array_r8 *vector) + { + /* r.* indicates the return array. */ + index_type rstride0; + GFC_REAL_8 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_REAL_8 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || compile_options.bounds_check) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + + /* TODO: We could speed up pack easily in the case of only + few .TRUE. entries in MASK, by keeping track of where we + would be in the source array during the initial traversal + of MASK, and caching the pointers to those elements. Then, + supposed the number of elements is small enough, we would + only have to traverse the list, and copy those elements + into the result array. In the case of datatypes which fit + in one of the integer types we could also cache the + value instead of a pointer to it. + This approach might be bad from the point of view of + cache behavior in the case where our cache is not big + enough to hold all elements that have to be copied. */ + + const GFC_LOGICAL_1 *m = mptr; + + total = 0; + if (zero_sized) + m = NULL; + + while (m) + { + /* Test this element. */ + if (*m) + total++; + + /* Advance to the next element. */ + m += mstride[0]; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it + and increment the next dimension. */ + count[n] = 0; + /* We could precalculate this product, but this is a + less frequently used path so probably not worth + it. */ + m -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + m = NULL; + break; + } + else + { + count[n]++; + m += mstride[n]; + } + } + } + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + ret->dim[0].lbound = 0; + ret->dim[0].ubound = total - 1; + ret->dim[0].stride = 1; + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_REAL_8) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = ret->dim[0].stride; + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = vector->dim[0].stride; + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_c10_i16.c gcc-4.4.0/libgfortran/generated/pow_c10_i16.c *** gcc-4.3.3/libgfortran/generated/pow_c10_i16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_c10_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_c10_i4.c gcc-4.4.0/libgfortran/generated/pow_c10_i4.c *** gcc-4.3.3/libgfortran/generated/pow_c10_i4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_c10_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_c10_i8.c gcc-4.4.0/libgfortran/generated/pow_c10_i8.c *** gcc-4.3.3/libgfortran/generated/pow_c10_i8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_c10_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_c16_i16.c gcc-4.4.0/libgfortran/generated/pow_c16_i16.c *** gcc-4.3.3/libgfortran/generated/pow_c16_i16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_c16_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_c16_i4.c gcc-4.4.0/libgfortran/generated/pow_c16_i4.c *** gcc-4.3.3/libgfortran/generated/pow_c16_i4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_c16_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_c16_i8.c gcc-4.4.0/libgfortran/generated/pow_c16_i8.c *** gcc-4.3.3/libgfortran/generated/pow_c16_i8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_c16_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_c4_i16.c gcc-4.4.0/libgfortran/generated/pow_c4_i16.c *** gcc-4.3.3/libgfortran/generated/pow_c4_i16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_c4_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_c4_i4.c gcc-4.4.0/libgfortran/generated/pow_c4_i4.c *** gcc-4.3.3/libgfortran/generated/pow_c4_i4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_c4_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_c4_i8.c gcc-4.4.0/libgfortran/generated/pow_c4_i8.c *** gcc-4.3.3/libgfortran/generated/pow_c4_i8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_c4_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_c8_i16.c gcc-4.4.0/libgfortran/generated/pow_c8_i16.c *** gcc-4.3.3/libgfortran/generated/pow_c8_i16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_c8_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_c8_i4.c gcc-4.4.0/libgfortran/generated/pow_c8_i4.c *** gcc-4.3.3/libgfortran/generated/pow_c8_i4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_c8_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_c8_i8.c gcc-4.4.0/libgfortran/generated/pow_c8_i8.c *** gcc-4.3.3/libgfortran/generated/pow_c8_i8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_c8_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_i16_i16.c gcc-4.4.0/libgfortran/generated/pow_i16_i16.c *** gcc-4.3.3/libgfortran/generated/pow_i16_i16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_i16_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_i16_i4.c gcc-4.4.0/libgfortran/generated/pow_i16_i4.c *** gcc-4.3.3/libgfortran/generated/pow_i16_i4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_i16_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_i16_i8.c gcc-4.4.0/libgfortran/generated/pow_i16_i8.c *** gcc-4.3.3/libgfortran/generated/pow_i16_i8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_i16_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_i4_i16.c gcc-4.4.0/libgfortran/generated/pow_i4_i16.c *** gcc-4.3.3/libgfortran/generated/pow_i4_i16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_i4_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_i4_i4.c gcc-4.4.0/libgfortran/generated/pow_i4_i4.c *** gcc-4.3.3/libgfortran/generated/pow_i4_i4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_i4_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_i4_i8.c gcc-4.4.0/libgfortran/generated/pow_i4_i8.c *** gcc-4.3.3/libgfortran/generated/pow_i4_i8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_i4_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_i8_i16.c gcc-4.4.0/libgfortran/generated/pow_i8_i16.c *** gcc-4.3.3/libgfortran/generated/pow_i8_i16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_i8_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_i8_i4.c gcc-4.4.0/libgfortran/generated/pow_i8_i4.c *** gcc-4.3.3/libgfortran/generated/pow_i8_i4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_i8_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_i8_i8.c gcc-4.4.0/libgfortran/generated/pow_i8_i8.c *** gcc-4.3.3/libgfortran/generated/pow_i8_i8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_i8_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_r10_i16.c gcc-4.4.0/libgfortran/generated/pow_r10_i16.c *** gcc-4.3.3/libgfortran/generated/pow_r10_i16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_r10_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_r10_i8.c gcc-4.4.0/libgfortran/generated/pow_r10_i8.c *** gcc-4.3.3/libgfortran/generated/pow_r10_i8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_r10_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_r16_i16.c gcc-4.4.0/libgfortran/generated/pow_r16_i16.c *** gcc-4.3.3/libgfortran/generated/pow_r16_i16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_r16_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_r16_i8.c gcc-4.4.0/libgfortran/generated/pow_r16_i8.c *** gcc-4.3.3/libgfortran/generated/pow_r16_i8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_r16_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_r4_i16.c gcc-4.4.0/libgfortran/generated/pow_r4_i16.c *** gcc-4.3.3/libgfortran/generated/pow_r4_i16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_r4_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_r4_i8.c gcc-4.4.0/libgfortran/generated/pow_r4_i8.c *** gcc-4.3.3/libgfortran/generated/pow_r4_i8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_r4_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_r8_i16.c gcc-4.4.0/libgfortran/generated/pow_r8_i16.c *** gcc-4.3.3/libgfortran/generated/pow_r8_i16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_r8_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/pow_r8_i8.c gcc-4.4.0/libgfortran/generated/pow_r8_i8.c *** gcc-4.3.3/libgfortran/generated/pow_r8_i8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/pow_r8_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/product_c10.c gcc-4.4.0/libgfortran/generated/product_c10.c *** gcc-4.3.3/libgfortran/generated/product_c10.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/product_c10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** product_c10 (gfc_array_c10 * const restr *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mproduct_c10 (gfc_array_c10 * const rest *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sproduct_c10 (gfc_array_c10 * const rest *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/product_c16.c gcc-4.4.0/libgfortran/generated/product_c16.c *** gcc-4.3.3/libgfortran/generated/product_c16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/product_c16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** product_c16 (gfc_array_c16 * const restr *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mproduct_c16 (gfc_array_c16 * const rest *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sproduct_c16 (gfc_array_c16 * const rest *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/product_c4.c gcc-4.4.0/libgfortran/generated/product_c4.c *** gcc-4.3.3/libgfortran/generated/product_c4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/product_c4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** product_c4 (gfc_array_c4 * const restric *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mproduct_c4 (gfc_array_c4 * const restri *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sproduct_c4 (gfc_array_c4 * const restri *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/product_c8.c gcc-4.4.0/libgfortran/generated/product_c8.c *** gcc-4.3.3/libgfortran/generated/product_c8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/product_c8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** product_c8 (gfc_array_c8 * const restric *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mproduct_c8 (gfc_array_c8 * const restri *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sproduct_c8 (gfc_array_c8 * const restri *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/product_i1.c gcc-4.4.0/libgfortran/generated/product_i1.c *** gcc-4.3.3/libgfortran/generated/product_i1.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/product_i1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** product_i1 (gfc_array_i1 * const restric *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mproduct_i1 (gfc_array_i1 * const restri *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sproduct_i1 (gfc_array_i1 * const restri *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/product_i16.c gcc-4.4.0/libgfortran/generated/product_i16.c *** gcc-4.3.3/libgfortran/generated/product_i16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/product_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** product_i16 (gfc_array_i16 * const restr *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mproduct_i16 (gfc_array_i16 * const rest *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sproduct_i16 (gfc_array_i16 * const rest *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/product_i2.c gcc-4.4.0/libgfortran/generated/product_i2.c *** gcc-4.3.3/libgfortran/generated/product_i2.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/product_i2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** product_i2 (gfc_array_i2 * const restric *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mproduct_i2 (gfc_array_i2 * const restri *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sproduct_i2 (gfc_array_i2 * const restri *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/product_i4.c gcc-4.4.0/libgfortran/generated/product_i4.c *** gcc-4.3.3/libgfortran/generated/product_i4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/product_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** product_i4 (gfc_array_i4 * const restric *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mproduct_i4 (gfc_array_i4 * const restri *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sproduct_i4 (gfc_array_i4 * const restri *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/product_i8.c gcc-4.4.0/libgfortran/generated/product_i8.c *** gcc-4.3.3/libgfortran/generated/product_i8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/product_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** product_i8 (gfc_array_i8 * const restric *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mproduct_i8 (gfc_array_i8 * const restri *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sproduct_i8 (gfc_array_i8 * const restri *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/product_r10.c gcc-4.4.0/libgfortran/generated/product_r10.c *** gcc-4.3.3/libgfortran/generated/product_r10.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/product_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** product_r10 (gfc_array_r10 * const restr *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mproduct_r10 (gfc_array_r10 * const rest *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sproduct_r10 (gfc_array_r10 * const rest *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/product_r16.c gcc-4.4.0/libgfortran/generated/product_r16.c *** gcc-4.3.3/libgfortran/generated/product_r16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/product_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** product_r16 (gfc_array_r16 * const restr *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mproduct_r16 (gfc_array_r16 * const rest *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sproduct_r16 (gfc_array_r16 * const rest *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/product_r4.c gcc-4.4.0/libgfortran/generated/product_r4.c *** gcc-4.3.3/libgfortran/generated/product_r4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/product_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** product_r4 (gfc_array_r4 * const restric *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mproduct_r4 (gfc_array_r4 * const restri *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sproduct_r4 (gfc_array_r4 * const restri *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/product_r8.c gcc-4.4.0/libgfortran/generated/product_r8.c *** gcc-4.3.3/libgfortran/generated/product_r8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/product_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** product_r8 (gfc_array_r8 * const restric *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** mproduct_r8 (gfc_array_r8 * const restri *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** sproduct_r8 (gfc_array_r8 * const restri *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/reshape_c10.c gcc-4.4.0/libgfortran/generated/reshape_c10.c *** gcc-4.3.3/libgfortran/generated/reshape_c10.c Sun Nov 23 15:08:32 2008 --- gcc-4.4.0/libgfortran/generated/reshape_c10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** reshape_c10 (gfc_array_c10 * const restr *** 81,96 **** const GFC_COMPLEX_10 *src; int n; int dim; ! int sempty, pempty; if (ret->data == NULL) { - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape->data[n * shape->dim[0].stride]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; --- 76,107 ---- const GFC_COMPLEX_10 *src; int n; int dim; ! int sempty, pempty, shape_empty; ! index_type shape_data[GFC_MAX_DIMENSIONS]; ! ! rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; ! if (rdim != GFC_DESCRIPTOR_RANK(ret)) ! runtime_error("rank of return array incorrect in RESHAPE intrinsic"); ! ! shape_empty = 0; ! ! for (n = 0; n < rdim; n++) ! { ! shape_data[n] = shape->data[n * shape->dim[0].stride]; ! if (shape_data[n] <= 0) ! { ! shape_data[n] = 0; ! shape_empty = 1; ! } ! } if (ret->data == NULL) { rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape_data[n]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; *************** reshape_c10 (gfc_array_c10 * const restr *** 99,107 **** ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_10)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } else { ! rdim = GFC_DESCRIPTOR_RANK (ret); } rsize = 1; --- 110,203 ---- ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_10)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } else { ! pdim = 0; ! psize = 1; ! pempty = 1; ! pptr = NULL; ! } ! ! if (unlikely (compile_options.bounds_check)) ! { ! index_type ret_extent, source_extent; ! ! rs = 1; ! for (n = 0; n < rdim; n++) ! { ! rs *= shape_data[n]; ! ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; ! if (ret_extent != shape_data[n]) ! runtime_error("Incorrect extent in return value of RESHAPE" ! " intrinsic in dimension %ld: is %ld," ! " should be %ld", (long int) n+1, ! (long int) ret_extent, (long int) shape_data[n]); ! } ! ! source_extent = 1; ! sdim = GFC_DESCRIPTOR_RANK (source); ! for (n = 0; n < sdim; n++) ! { ! index_type se; ! se = source->dim[n].ubound + 1 - source->dim[0].lbound; ! source_extent *= se > 0 ? se : 0; ! } ! ! if (rs > source_extent && (!pad || pempty)) ! runtime_error("Incorrect size in SOURCE argument to RESHAPE" ! " intrinsic: is %ld, should be %ld", ! (long int) source_extent, (long int) rs); ! ! if (order) ! { ! int seen[GFC_MAX_DIMENSIONS]; ! index_type v; ! ! for (n = 0; n < rdim; n++) ! seen[n] = 0; ! ! for (n = 0; n < rdim; n++) ! { ! v = order->data[n * order->dim[0].stride] - 1; ! ! if (v < 0 || v >= rdim) ! runtime_error("Value %ld out of range in ORDER argument" ! " to RESHAPE intrinsic", (long int) v + 1); ! ! if (seen[v] != 0) ! runtime_error("Duplicate value %ld in ORDER argument to" ! " RESHAPE intrinsic", (long int) v + 1); ! ! seen[v] = 1; ! } ! } } rsize = 1; *************** reshape_c10 (gfc_array_c10 * const restr *** 115,122 **** rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; ! if (rextent[n] != shape->data[dim * shape->dim[0].stride]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) --- 211,220 ---- rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + if (rextent[n] < 0) + rextent[n] = 0; ! if (rextent[n] != shape_data[dim]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) *************** reshape_c10 (gfc_array_c10 * const restr *** 147,183 **** ssize = 0; } - if (pad) - { - pdim = GFC_DESCRIPTOR_RANK (pad); - psize = 1; - pempty = 0; - for (n = 0; n < pdim; n++) - { - pcount[n] = 0; - pstride[n] = pad->dim[n].stride; - pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; - if (pextent[n] <= 0) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_COMPLEX_10); --- 245,250 ---- diff -Nrcpad gcc-4.3.3/libgfortran/generated/reshape_c16.c gcc-4.4.0/libgfortran/generated/reshape_c16.c *** gcc-4.3.3/libgfortran/generated/reshape_c16.c Sun Nov 23 15:08:32 2008 --- gcc-4.4.0/libgfortran/generated/reshape_c16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** reshape_c16 (gfc_array_c16 * const restr *** 81,96 **** const GFC_COMPLEX_16 *src; int n; int dim; ! int sempty, pempty; if (ret->data == NULL) { - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape->data[n * shape->dim[0].stride]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; --- 76,107 ---- const GFC_COMPLEX_16 *src; int n; int dim; ! int sempty, pempty, shape_empty; ! index_type shape_data[GFC_MAX_DIMENSIONS]; ! ! rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; ! if (rdim != GFC_DESCRIPTOR_RANK(ret)) ! runtime_error("rank of return array incorrect in RESHAPE intrinsic"); ! ! shape_empty = 0; ! ! for (n = 0; n < rdim; n++) ! { ! shape_data[n] = shape->data[n * shape->dim[0].stride]; ! if (shape_data[n] <= 0) ! { ! shape_data[n] = 0; ! shape_empty = 1; ! } ! } if (ret->data == NULL) { rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape_data[n]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; *************** reshape_c16 (gfc_array_c16 * const restr *** 99,107 **** ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_16)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } else { ! rdim = GFC_DESCRIPTOR_RANK (ret); } rsize = 1; --- 110,203 ---- ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_16)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } else { ! pdim = 0; ! psize = 1; ! pempty = 1; ! pptr = NULL; ! } ! ! if (unlikely (compile_options.bounds_check)) ! { ! index_type ret_extent, source_extent; ! ! rs = 1; ! for (n = 0; n < rdim; n++) ! { ! rs *= shape_data[n]; ! ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; ! if (ret_extent != shape_data[n]) ! runtime_error("Incorrect extent in return value of RESHAPE" ! " intrinsic in dimension %ld: is %ld," ! " should be %ld", (long int) n+1, ! (long int) ret_extent, (long int) shape_data[n]); ! } ! ! source_extent = 1; ! sdim = GFC_DESCRIPTOR_RANK (source); ! for (n = 0; n < sdim; n++) ! { ! index_type se; ! se = source->dim[n].ubound + 1 - source->dim[0].lbound; ! source_extent *= se > 0 ? se : 0; ! } ! ! if (rs > source_extent && (!pad || pempty)) ! runtime_error("Incorrect size in SOURCE argument to RESHAPE" ! " intrinsic: is %ld, should be %ld", ! (long int) source_extent, (long int) rs); ! ! if (order) ! { ! int seen[GFC_MAX_DIMENSIONS]; ! index_type v; ! ! for (n = 0; n < rdim; n++) ! seen[n] = 0; ! ! for (n = 0; n < rdim; n++) ! { ! v = order->data[n * order->dim[0].stride] - 1; ! ! if (v < 0 || v >= rdim) ! runtime_error("Value %ld out of range in ORDER argument" ! " to RESHAPE intrinsic", (long int) v + 1); ! ! if (seen[v] != 0) ! runtime_error("Duplicate value %ld in ORDER argument to" ! " RESHAPE intrinsic", (long int) v + 1); ! ! seen[v] = 1; ! } ! } } rsize = 1; *************** reshape_c16 (gfc_array_c16 * const restr *** 115,122 **** rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; ! if (rextent[n] != shape->data[dim * shape->dim[0].stride]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) --- 211,220 ---- rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + if (rextent[n] < 0) + rextent[n] = 0; ! if (rextent[n] != shape_data[dim]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) *************** reshape_c16 (gfc_array_c16 * const restr *** 147,183 **** ssize = 0; } - if (pad) - { - pdim = GFC_DESCRIPTOR_RANK (pad); - psize = 1; - pempty = 0; - for (n = 0; n < pdim; n++) - { - pcount[n] = 0; - pstride[n] = pad->dim[n].stride; - pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; - if (pextent[n] <= 0) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_COMPLEX_16); --- 245,250 ---- diff -Nrcpad gcc-4.3.3/libgfortran/generated/reshape_c4.c gcc-4.4.0/libgfortran/generated/reshape_c4.c *** gcc-4.3.3/libgfortran/generated/reshape_c4.c Sun Nov 23 15:08:32 2008 --- gcc-4.4.0/libgfortran/generated/reshape_c4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** reshape_c4 (gfc_array_c4 * const restric *** 81,96 **** const GFC_COMPLEX_4 *src; int n; int dim; ! int sempty, pempty; if (ret->data == NULL) { - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape->data[n * shape->dim[0].stride]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; --- 76,107 ---- const GFC_COMPLEX_4 *src; int n; int dim; ! int sempty, pempty, shape_empty; ! index_type shape_data[GFC_MAX_DIMENSIONS]; ! ! rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; ! if (rdim != GFC_DESCRIPTOR_RANK(ret)) ! runtime_error("rank of return array incorrect in RESHAPE intrinsic"); ! ! shape_empty = 0; ! ! for (n = 0; n < rdim; n++) ! { ! shape_data[n] = shape->data[n * shape->dim[0].stride]; ! if (shape_data[n] <= 0) ! { ! shape_data[n] = 0; ! shape_empty = 1; ! } ! } if (ret->data == NULL) { rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape_data[n]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; *************** reshape_c4 (gfc_array_c4 * const restric *** 99,107 **** ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_4)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } else { ! rdim = GFC_DESCRIPTOR_RANK (ret); } rsize = 1; --- 110,203 ---- ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_4)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } else { ! pdim = 0; ! psize = 1; ! pempty = 1; ! pptr = NULL; ! } ! ! if (unlikely (compile_options.bounds_check)) ! { ! index_type ret_extent, source_extent; ! ! rs = 1; ! for (n = 0; n < rdim; n++) ! { ! rs *= shape_data[n]; ! ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; ! if (ret_extent != shape_data[n]) ! runtime_error("Incorrect extent in return value of RESHAPE" ! " intrinsic in dimension %ld: is %ld," ! " should be %ld", (long int) n+1, ! (long int) ret_extent, (long int) shape_data[n]); ! } ! ! source_extent = 1; ! sdim = GFC_DESCRIPTOR_RANK (source); ! for (n = 0; n < sdim; n++) ! { ! index_type se; ! se = source->dim[n].ubound + 1 - source->dim[0].lbound; ! source_extent *= se > 0 ? se : 0; ! } ! ! if (rs > source_extent && (!pad || pempty)) ! runtime_error("Incorrect size in SOURCE argument to RESHAPE" ! " intrinsic: is %ld, should be %ld", ! (long int) source_extent, (long int) rs); ! ! if (order) ! { ! int seen[GFC_MAX_DIMENSIONS]; ! index_type v; ! ! for (n = 0; n < rdim; n++) ! seen[n] = 0; ! ! for (n = 0; n < rdim; n++) ! { ! v = order->data[n * order->dim[0].stride] - 1; ! ! if (v < 0 || v >= rdim) ! runtime_error("Value %ld out of range in ORDER argument" ! " to RESHAPE intrinsic", (long int) v + 1); ! ! if (seen[v] != 0) ! runtime_error("Duplicate value %ld in ORDER argument to" ! " RESHAPE intrinsic", (long int) v + 1); ! ! seen[v] = 1; ! } ! } } rsize = 1; *************** reshape_c4 (gfc_array_c4 * const restric *** 115,122 **** rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; ! if (rextent[n] != shape->data[dim * shape->dim[0].stride]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) --- 211,220 ---- rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + if (rextent[n] < 0) + rextent[n] = 0; ! if (rextent[n] != shape_data[dim]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) *************** reshape_c4 (gfc_array_c4 * const restric *** 147,183 **** ssize = 0; } - if (pad) - { - pdim = GFC_DESCRIPTOR_RANK (pad); - psize = 1; - pempty = 0; - for (n = 0; n < pdim; n++) - { - pcount[n] = 0; - pstride[n] = pad->dim[n].stride; - pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; - if (pextent[n] <= 0) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_COMPLEX_4); --- 245,250 ---- diff -Nrcpad gcc-4.3.3/libgfortran/generated/reshape_c8.c gcc-4.4.0/libgfortran/generated/reshape_c8.c *** gcc-4.3.3/libgfortran/generated/reshape_c8.c Sun Nov 23 15:08:32 2008 --- gcc-4.4.0/libgfortran/generated/reshape_c8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** reshape_c8 (gfc_array_c8 * const restric *** 81,96 **** const GFC_COMPLEX_8 *src; int n; int dim; ! int sempty, pempty; if (ret->data == NULL) { - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape->data[n * shape->dim[0].stride]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; --- 76,107 ---- const GFC_COMPLEX_8 *src; int n; int dim; ! int sempty, pempty, shape_empty; ! index_type shape_data[GFC_MAX_DIMENSIONS]; ! ! rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; ! if (rdim != GFC_DESCRIPTOR_RANK(ret)) ! runtime_error("rank of return array incorrect in RESHAPE intrinsic"); ! ! shape_empty = 0; ! ! for (n = 0; n < rdim; n++) ! { ! shape_data[n] = shape->data[n * shape->dim[0].stride]; ! if (shape_data[n] <= 0) ! { ! shape_data[n] = 0; ! shape_empty = 1; ! } ! } if (ret->data == NULL) { rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape_data[n]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; *************** reshape_c8 (gfc_array_c8 * const restric *** 99,107 **** ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_8)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } else { ! rdim = GFC_DESCRIPTOR_RANK (ret); } rsize = 1; --- 110,203 ---- ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_8)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } else { ! pdim = 0; ! psize = 1; ! pempty = 1; ! pptr = NULL; ! } ! ! if (unlikely (compile_options.bounds_check)) ! { ! index_type ret_extent, source_extent; ! ! rs = 1; ! for (n = 0; n < rdim; n++) ! { ! rs *= shape_data[n]; ! ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; ! if (ret_extent != shape_data[n]) ! runtime_error("Incorrect extent in return value of RESHAPE" ! " intrinsic in dimension %ld: is %ld," ! " should be %ld", (long int) n+1, ! (long int) ret_extent, (long int) shape_data[n]); ! } ! ! source_extent = 1; ! sdim = GFC_DESCRIPTOR_RANK (source); ! for (n = 0; n < sdim; n++) ! { ! index_type se; ! se = source->dim[n].ubound + 1 - source->dim[0].lbound; ! source_extent *= se > 0 ? se : 0; ! } ! ! if (rs > source_extent && (!pad || pempty)) ! runtime_error("Incorrect size in SOURCE argument to RESHAPE" ! " intrinsic: is %ld, should be %ld", ! (long int) source_extent, (long int) rs); ! ! if (order) ! { ! int seen[GFC_MAX_DIMENSIONS]; ! index_type v; ! ! for (n = 0; n < rdim; n++) ! seen[n] = 0; ! ! for (n = 0; n < rdim; n++) ! { ! v = order->data[n * order->dim[0].stride] - 1; ! ! if (v < 0 || v >= rdim) ! runtime_error("Value %ld out of range in ORDER argument" ! " to RESHAPE intrinsic", (long int) v + 1); ! ! if (seen[v] != 0) ! runtime_error("Duplicate value %ld in ORDER argument to" ! " RESHAPE intrinsic", (long int) v + 1); ! ! seen[v] = 1; ! } ! } } rsize = 1; *************** reshape_c8 (gfc_array_c8 * const restric *** 115,122 **** rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; ! if (rextent[n] != shape->data[dim * shape->dim[0].stride]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) --- 211,220 ---- rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + if (rextent[n] < 0) + rextent[n] = 0; ! if (rextent[n] != shape_data[dim]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) *************** reshape_c8 (gfc_array_c8 * const restric *** 147,183 **** ssize = 0; } - if (pad) - { - pdim = GFC_DESCRIPTOR_RANK (pad); - psize = 1; - pempty = 0; - for (n = 0; n < pdim; n++) - { - pcount[n] = 0; - pstride[n] = pad->dim[n].stride; - pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; - if (pextent[n] <= 0) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_COMPLEX_8); --- 245,250 ---- diff -Nrcpad gcc-4.3.3/libgfortran/generated/reshape_i16.c gcc-4.4.0/libgfortran/generated/reshape_i16.c *** gcc-4.3.3/libgfortran/generated/reshape_i16.c Sun Nov 23 15:08:32 2008 --- gcc-4.4.0/libgfortran/generated/reshape_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** reshape_16 (gfc_array_i16 * const restri *** 81,96 **** const GFC_INTEGER_16 *src; int n; int dim; ! int sempty, pempty; if (ret->data == NULL) { - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape->data[n * shape->dim[0].stride]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; --- 76,107 ---- const GFC_INTEGER_16 *src; int n; int dim; ! int sempty, pempty, shape_empty; ! index_type shape_data[GFC_MAX_DIMENSIONS]; ! ! rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; ! if (rdim != GFC_DESCRIPTOR_RANK(ret)) ! runtime_error("rank of return array incorrect in RESHAPE intrinsic"); ! ! shape_empty = 0; ! ! for (n = 0; n < rdim; n++) ! { ! shape_data[n] = shape->data[n * shape->dim[0].stride]; ! if (shape_data[n] <= 0) ! { ! shape_data[n] = 0; ! shape_empty = 1; ! } ! } if (ret->data == NULL) { rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape_data[n]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; *************** reshape_16 (gfc_array_i16 * const restri *** 99,107 **** ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_16)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } else { ! rdim = GFC_DESCRIPTOR_RANK (ret); } rsize = 1; --- 110,203 ---- ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_16)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } else { ! pdim = 0; ! psize = 1; ! pempty = 1; ! pptr = NULL; ! } ! ! if (unlikely (compile_options.bounds_check)) ! { ! index_type ret_extent, source_extent; ! ! rs = 1; ! for (n = 0; n < rdim; n++) ! { ! rs *= shape_data[n]; ! ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; ! if (ret_extent != shape_data[n]) ! runtime_error("Incorrect extent in return value of RESHAPE" ! " intrinsic in dimension %ld: is %ld," ! " should be %ld", (long int) n+1, ! (long int) ret_extent, (long int) shape_data[n]); ! } ! ! source_extent = 1; ! sdim = GFC_DESCRIPTOR_RANK (source); ! for (n = 0; n < sdim; n++) ! { ! index_type se; ! se = source->dim[n].ubound + 1 - source->dim[0].lbound; ! source_extent *= se > 0 ? se : 0; ! } ! ! if (rs > source_extent && (!pad || pempty)) ! runtime_error("Incorrect size in SOURCE argument to RESHAPE" ! " intrinsic: is %ld, should be %ld", ! (long int) source_extent, (long int) rs); ! ! if (order) ! { ! int seen[GFC_MAX_DIMENSIONS]; ! index_type v; ! ! for (n = 0; n < rdim; n++) ! seen[n] = 0; ! ! for (n = 0; n < rdim; n++) ! { ! v = order->data[n * order->dim[0].stride] - 1; ! ! if (v < 0 || v >= rdim) ! runtime_error("Value %ld out of range in ORDER argument" ! " to RESHAPE intrinsic", (long int) v + 1); ! ! if (seen[v] != 0) ! runtime_error("Duplicate value %ld in ORDER argument to" ! " RESHAPE intrinsic", (long int) v + 1); ! ! seen[v] = 1; ! } ! } } rsize = 1; *************** reshape_16 (gfc_array_i16 * const restri *** 115,122 **** rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; ! if (rextent[n] != shape->data[dim * shape->dim[0].stride]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) --- 211,220 ---- rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + if (rextent[n] < 0) + rextent[n] = 0; ! if (rextent[n] != shape_data[dim]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) *************** reshape_16 (gfc_array_i16 * const restri *** 147,183 **** ssize = 0; } - if (pad) - { - pdim = GFC_DESCRIPTOR_RANK (pad); - psize = 1; - pempty = 0; - for (n = 0; n < pdim; n++) - { - pcount[n] = 0; - pstride[n] = pad->dim[n].stride; - pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; - if (pextent[n] <= 0) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_INTEGER_16); --- 245,250 ---- diff -Nrcpad gcc-4.3.3/libgfortran/generated/reshape_i4.c gcc-4.4.0/libgfortran/generated/reshape_i4.c *** gcc-4.3.3/libgfortran/generated/reshape_i4.c Sun Nov 23 15:08:32 2008 --- gcc-4.4.0/libgfortran/generated/reshape_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** reshape_4 (gfc_array_i4 * const restrict *** 81,96 **** const GFC_INTEGER_4 *src; int n; int dim; ! int sempty, pempty; if (ret->data == NULL) { - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape->data[n * shape->dim[0].stride]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; --- 76,107 ---- const GFC_INTEGER_4 *src; int n; int dim; ! int sempty, pempty, shape_empty; ! index_type shape_data[GFC_MAX_DIMENSIONS]; ! ! rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; ! if (rdim != GFC_DESCRIPTOR_RANK(ret)) ! runtime_error("rank of return array incorrect in RESHAPE intrinsic"); ! ! shape_empty = 0; ! ! for (n = 0; n < rdim; n++) ! { ! shape_data[n] = shape->data[n * shape->dim[0].stride]; ! if (shape_data[n] <= 0) ! { ! shape_data[n] = 0; ! shape_empty = 1; ! } ! } if (ret->data == NULL) { rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape_data[n]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; *************** reshape_4 (gfc_array_i4 * const restrict *** 99,107 **** ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_4)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } else { ! rdim = GFC_DESCRIPTOR_RANK (ret); } rsize = 1; --- 110,203 ---- ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_4)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } else { ! pdim = 0; ! psize = 1; ! pempty = 1; ! pptr = NULL; ! } ! ! if (unlikely (compile_options.bounds_check)) ! { ! index_type ret_extent, source_extent; ! ! rs = 1; ! for (n = 0; n < rdim; n++) ! { ! rs *= shape_data[n]; ! ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; ! if (ret_extent != shape_data[n]) ! runtime_error("Incorrect extent in return value of RESHAPE" ! " intrinsic in dimension %ld: is %ld," ! " should be %ld", (long int) n+1, ! (long int) ret_extent, (long int) shape_data[n]); ! } ! ! source_extent = 1; ! sdim = GFC_DESCRIPTOR_RANK (source); ! for (n = 0; n < sdim; n++) ! { ! index_type se; ! se = source->dim[n].ubound + 1 - source->dim[0].lbound; ! source_extent *= se > 0 ? se : 0; ! } ! ! if (rs > source_extent && (!pad || pempty)) ! runtime_error("Incorrect size in SOURCE argument to RESHAPE" ! " intrinsic: is %ld, should be %ld", ! (long int) source_extent, (long int) rs); ! ! if (order) ! { ! int seen[GFC_MAX_DIMENSIONS]; ! index_type v; ! ! for (n = 0; n < rdim; n++) ! seen[n] = 0; ! ! for (n = 0; n < rdim; n++) ! { ! v = order->data[n * order->dim[0].stride] - 1; ! ! if (v < 0 || v >= rdim) ! runtime_error("Value %ld out of range in ORDER argument" ! " to RESHAPE intrinsic", (long int) v + 1); ! ! if (seen[v] != 0) ! runtime_error("Duplicate value %ld in ORDER argument to" ! " RESHAPE intrinsic", (long int) v + 1); ! ! seen[v] = 1; ! } ! } } rsize = 1; *************** reshape_4 (gfc_array_i4 * const restrict *** 115,122 **** rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; ! if (rextent[n] != shape->data[dim * shape->dim[0].stride]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) --- 211,220 ---- rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + if (rextent[n] < 0) + rextent[n] = 0; ! if (rextent[n] != shape_data[dim]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) *************** reshape_4 (gfc_array_i4 * const restrict *** 147,183 **** ssize = 0; } - if (pad) - { - pdim = GFC_DESCRIPTOR_RANK (pad); - psize = 1; - pempty = 0; - for (n = 0; n < pdim; n++) - { - pcount[n] = 0; - pstride[n] = pad->dim[n].stride; - pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; - if (pextent[n] <= 0) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_INTEGER_4); --- 245,250 ---- diff -Nrcpad gcc-4.3.3/libgfortran/generated/reshape_i8.c gcc-4.4.0/libgfortran/generated/reshape_i8.c *** gcc-4.3.3/libgfortran/generated/reshape_i8.c Sun Nov 23 15:08:32 2008 --- gcc-4.4.0/libgfortran/generated/reshape_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** reshape_8 (gfc_array_i8 * const restrict *** 81,96 **** const GFC_INTEGER_8 *src; int n; int dim; ! int sempty, pempty; if (ret->data == NULL) { - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape->data[n * shape->dim[0].stride]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; --- 76,107 ---- const GFC_INTEGER_8 *src; int n; int dim; ! int sempty, pempty, shape_empty; ! index_type shape_data[GFC_MAX_DIMENSIONS]; ! ! rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; ! if (rdim != GFC_DESCRIPTOR_RANK(ret)) ! runtime_error("rank of return array incorrect in RESHAPE intrinsic"); ! ! shape_empty = 0; ! ! for (n = 0; n < rdim; n++) ! { ! shape_data[n] = shape->data[n * shape->dim[0].stride]; ! if (shape_data[n] <= 0) ! { ! shape_data[n] = 0; ! shape_empty = 1; ! } ! } if (ret->data == NULL) { rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape_data[n]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; *************** reshape_8 (gfc_array_i8 * const restrict *** 99,107 **** ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_8)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } else { ! rdim = GFC_DESCRIPTOR_RANK (ret); } rsize = 1; --- 110,203 ---- ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_8)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } else { ! pdim = 0; ! psize = 1; ! pempty = 1; ! pptr = NULL; ! } ! ! if (unlikely (compile_options.bounds_check)) ! { ! index_type ret_extent, source_extent; ! ! rs = 1; ! for (n = 0; n < rdim; n++) ! { ! rs *= shape_data[n]; ! ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; ! if (ret_extent != shape_data[n]) ! runtime_error("Incorrect extent in return value of RESHAPE" ! " intrinsic in dimension %ld: is %ld," ! " should be %ld", (long int) n+1, ! (long int) ret_extent, (long int) shape_data[n]); ! } ! ! source_extent = 1; ! sdim = GFC_DESCRIPTOR_RANK (source); ! for (n = 0; n < sdim; n++) ! { ! index_type se; ! se = source->dim[n].ubound + 1 - source->dim[0].lbound; ! source_extent *= se > 0 ? se : 0; ! } ! ! if (rs > source_extent && (!pad || pempty)) ! runtime_error("Incorrect size in SOURCE argument to RESHAPE" ! " intrinsic: is %ld, should be %ld", ! (long int) source_extent, (long int) rs); ! ! if (order) ! { ! int seen[GFC_MAX_DIMENSIONS]; ! index_type v; ! ! for (n = 0; n < rdim; n++) ! seen[n] = 0; ! ! for (n = 0; n < rdim; n++) ! { ! v = order->data[n * order->dim[0].stride] - 1; ! ! if (v < 0 || v >= rdim) ! runtime_error("Value %ld out of range in ORDER argument" ! " to RESHAPE intrinsic", (long int) v + 1); ! ! if (seen[v] != 0) ! runtime_error("Duplicate value %ld in ORDER argument to" ! " RESHAPE intrinsic", (long int) v + 1); ! ! seen[v] = 1; ! } ! } } rsize = 1; *************** reshape_8 (gfc_array_i8 * const restrict *** 115,122 **** rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; ! if (rextent[n] != shape->data[dim * shape->dim[0].stride]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) --- 211,220 ---- rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + if (rextent[n] < 0) + rextent[n] = 0; ! if (rextent[n] != shape_data[dim]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) *************** reshape_8 (gfc_array_i8 * const restrict *** 147,183 **** ssize = 0; } - if (pad) - { - pdim = GFC_DESCRIPTOR_RANK (pad); - psize = 1; - pempty = 0; - for (n = 0; n < pdim; n++) - { - pcount[n] = 0; - pstride[n] = pad->dim[n].stride; - pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; - if (pextent[n] <= 0) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_INTEGER_8); --- 245,250 ---- diff -Nrcpad gcc-4.3.3/libgfortran/generated/reshape_r10.c gcc-4.4.0/libgfortran/generated/reshape_r10.c *** gcc-4.3.3/libgfortran/generated/reshape_r10.c Sun Nov 23 15:08:32 2008 --- gcc-4.4.0/libgfortran/generated/reshape_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** reshape_r10 (gfc_array_r10 * const restr *** 81,96 **** const GFC_REAL_10 *src; int n; int dim; ! int sempty, pempty; if (ret->data == NULL) { - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape->data[n * shape->dim[0].stride]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; --- 76,107 ---- const GFC_REAL_10 *src; int n; int dim; ! int sempty, pempty, shape_empty; ! index_type shape_data[GFC_MAX_DIMENSIONS]; ! ! rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; ! if (rdim != GFC_DESCRIPTOR_RANK(ret)) ! runtime_error("rank of return array incorrect in RESHAPE intrinsic"); ! ! shape_empty = 0; ! ! for (n = 0; n < rdim; n++) ! { ! shape_data[n] = shape->data[n * shape->dim[0].stride]; ! if (shape_data[n] <= 0) ! { ! shape_data[n] = 0; ! shape_empty = 1; ! } ! } if (ret->data == NULL) { rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape_data[n]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; *************** reshape_r10 (gfc_array_r10 * const restr *** 99,107 **** ret->data = internal_malloc_size ( rs * sizeof (GFC_REAL_10)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } else { ! rdim = GFC_DESCRIPTOR_RANK (ret); } rsize = 1; --- 110,203 ---- ret->data = internal_malloc_size ( rs * sizeof (GFC_REAL_10)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } else { ! pdim = 0; ! psize = 1; ! pempty = 1; ! pptr = NULL; ! } ! ! if (unlikely (compile_options.bounds_check)) ! { ! index_type ret_extent, source_extent; ! ! rs = 1; ! for (n = 0; n < rdim; n++) ! { ! rs *= shape_data[n]; ! ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; ! if (ret_extent != shape_data[n]) ! runtime_error("Incorrect extent in return value of RESHAPE" ! " intrinsic in dimension %ld: is %ld," ! " should be %ld", (long int) n+1, ! (long int) ret_extent, (long int) shape_data[n]); ! } ! ! source_extent = 1; ! sdim = GFC_DESCRIPTOR_RANK (source); ! for (n = 0; n < sdim; n++) ! { ! index_type se; ! se = source->dim[n].ubound + 1 - source->dim[0].lbound; ! source_extent *= se > 0 ? se : 0; ! } ! ! if (rs > source_extent && (!pad || pempty)) ! runtime_error("Incorrect size in SOURCE argument to RESHAPE" ! " intrinsic: is %ld, should be %ld", ! (long int) source_extent, (long int) rs); ! ! if (order) ! { ! int seen[GFC_MAX_DIMENSIONS]; ! index_type v; ! ! for (n = 0; n < rdim; n++) ! seen[n] = 0; ! ! for (n = 0; n < rdim; n++) ! { ! v = order->data[n * order->dim[0].stride] - 1; ! ! if (v < 0 || v >= rdim) ! runtime_error("Value %ld out of range in ORDER argument" ! " to RESHAPE intrinsic", (long int) v + 1); ! ! if (seen[v] != 0) ! runtime_error("Duplicate value %ld in ORDER argument to" ! " RESHAPE intrinsic", (long int) v + 1); ! ! seen[v] = 1; ! } ! } } rsize = 1; *************** reshape_r10 (gfc_array_r10 * const restr *** 115,122 **** rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; ! if (rextent[n] != shape->data[dim * shape->dim[0].stride]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) --- 211,220 ---- rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + if (rextent[n] < 0) + rextent[n] = 0; ! if (rextent[n] != shape_data[dim]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) *************** reshape_r10 (gfc_array_r10 * const restr *** 147,183 **** ssize = 0; } - if (pad) - { - pdim = GFC_DESCRIPTOR_RANK (pad); - psize = 1; - pempty = 0; - for (n = 0; n < pdim; n++) - { - pcount[n] = 0; - pstride[n] = pad->dim[n].stride; - pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; - if (pextent[n] <= 0) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_REAL_10); --- 245,250 ---- diff -Nrcpad gcc-4.3.3/libgfortran/generated/reshape_r16.c gcc-4.4.0/libgfortran/generated/reshape_r16.c *** gcc-4.3.3/libgfortran/generated/reshape_r16.c Sun Nov 23 15:08:32 2008 --- gcc-4.4.0/libgfortran/generated/reshape_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** reshape_r16 (gfc_array_r16 * const restr *** 81,96 **** const GFC_REAL_16 *src; int n; int dim; ! int sempty, pempty; if (ret->data == NULL) { - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape->data[n * shape->dim[0].stride]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; --- 76,107 ---- const GFC_REAL_16 *src; int n; int dim; ! int sempty, pempty, shape_empty; ! index_type shape_data[GFC_MAX_DIMENSIONS]; ! ! rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; ! if (rdim != GFC_DESCRIPTOR_RANK(ret)) ! runtime_error("rank of return array incorrect in RESHAPE intrinsic"); ! ! shape_empty = 0; ! ! for (n = 0; n < rdim; n++) ! { ! shape_data[n] = shape->data[n * shape->dim[0].stride]; ! if (shape_data[n] <= 0) ! { ! shape_data[n] = 0; ! shape_empty = 1; ! } ! } if (ret->data == NULL) { rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape_data[n]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; *************** reshape_r16 (gfc_array_r16 * const restr *** 99,107 **** ret->data = internal_malloc_size ( rs * sizeof (GFC_REAL_16)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } else { ! rdim = GFC_DESCRIPTOR_RANK (ret); } rsize = 1; --- 110,203 ---- ret->data = internal_malloc_size ( rs * sizeof (GFC_REAL_16)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } else { ! pdim = 0; ! psize = 1; ! pempty = 1; ! pptr = NULL; ! } ! ! if (unlikely (compile_options.bounds_check)) ! { ! index_type ret_extent, source_extent; ! ! rs = 1; ! for (n = 0; n < rdim; n++) ! { ! rs *= shape_data[n]; ! ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; ! if (ret_extent != shape_data[n]) ! runtime_error("Incorrect extent in return value of RESHAPE" ! " intrinsic in dimension %ld: is %ld," ! " should be %ld", (long int) n+1, ! (long int) ret_extent, (long int) shape_data[n]); ! } ! ! source_extent = 1; ! sdim = GFC_DESCRIPTOR_RANK (source); ! for (n = 0; n < sdim; n++) ! { ! index_type se; ! se = source->dim[n].ubound + 1 - source->dim[0].lbound; ! source_extent *= se > 0 ? se : 0; ! } ! ! if (rs > source_extent && (!pad || pempty)) ! runtime_error("Incorrect size in SOURCE argument to RESHAPE" ! " intrinsic: is %ld, should be %ld", ! (long int) source_extent, (long int) rs); ! ! if (order) ! { ! int seen[GFC_MAX_DIMENSIONS]; ! index_type v; ! ! for (n = 0; n < rdim; n++) ! seen[n] = 0; ! ! for (n = 0; n < rdim; n++) ! { ! v = order->data[n * order->dim[0].stride] - 1; ! ! if (v < 0 || v >= rdim) ! runtime_error("Value %ld out of range in ORDER argument" ! " to RESHAPE intrinsic", (long int) v + 1); ! ! if (seen[v] != 0) ! runtime_error("Duplicate value %ld in ORDER argument to" ! " RESHAPE intrinsic", (long int) v + 1); ! ! seen[v] = 1; ! } ! } } rsize = 1; *************** reshape_r16 (gfc_array_r16 * const restr *** 115,122 **** rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; ! if (rextent[n] != shape->data[dim * shape->dim[0].stride]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) --- 211,220 ---- rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + if (rextent[n] < 0) + rextent[n] = 0; ! if (rextent[n] != shape_data[dim]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) *************** reshape_r16 (gfc_array_r16 * const restr *** 147,183 **** ssize = 0; } - if (pad) - { - pdim = GFC_DESCRIPTOR_RANK (pad); - psize = 1; - pempty = 0; - for (n = 0; n < pdim; n++) - { - pcount[n] = 0; - pstride[n] = pad->dim[n].stride; - pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; - if (pextent[n] <= 0) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_REAL_16); --- 245,250 ---- diff -Nrcpad gcc-4.3.3/libgfortran/generated/reshape_r4.c gcc-4.4.0/libgfortran/generated/reshape_r4.c *** gcc-4.3.3/libgfortran/generated/reshape_r4.c Sun Nov 23 15:08:32 2008 --- gcc-4.4.0/libgfortran/generated/reshape_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** reshape_r4 (gfc_array_r4 * const restric *** 81,96 **** const GFC_REAL_4 *src; int n; int dim; ! int sempty, pempty; if (ret->data == NULL) { - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape->data[n * shape->dim[0].stride]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; --- 76,107 ---- const GFC_REAL_4 *src; int n; int dim; ! int sempty, pempty, shape_empty; ! index_type shape_data[GFC_MAX_DIMENSIONS]; ! ! rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; ! if (rdim != GFC_DESCRIPTOR_RANK(ret)) ! runtime_error("rank of return array incorrect in RESHAPE intrinsic"); ! ! shape_empty = 0; ! ! for (n = 0; n < rdim; n++) ! { ! shape_data[n] = shape->data[n * shape->dim[0].stride]; ! if (shape_data[n] <= 0) ! { ! shape_data[n] = 0; ! shape_empty = 1; ! } ! } if (ret->data == NULL) { rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape_data[n]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; *************** reshape_r4 (gfc_array_r4 * const restric *** 99,107 **** ret->data = internal_malloc_size ( rs * sizeof (GFC_REAL_4)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } else { ! rdim = GFC_DESCRIPTOR_RANK (ret); } rsize = 1; --- 110,203 ---- ret->data = internal_malloc_size ( rs * sizeof (GFC_REAL_4)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } else { ! pdim = 0; ! psize = 1; ! pempty = 1; ! pptr = NULL; ! } ! ! if (unlikely (compile_options.bounds_check)) ! { ! index_type ret_extent, source_extent; ! ! rs = 1; ! for (n = 0; n < rdim; n++) ! { ! rs *= shape_data[n]; ! ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; ! if (ret_extent != shape_data[n]) ! runtime_error("Incorrect extent in return value of RESHAPE" ! " intrinsic in dimension %ld: is %ld," ! " should be %ld", (long int) n+1, ! (long int) ret_extent, (long int) shape_data[n]); ! } ! ! source_extent = 1; ! sdim = GFC_DESCRIPTOR_RANK (source); ! for (n = 0; n < sdim; n++) ! { ! index_type se; ! se = source->dim[n].ubound + 1 - source->dim[0].lbound; ! source_extent *= se > 0 ? se : 0; ! } ! ! if (rs > source_extent && (!pad || pempty)) ! runtime_error("Incorrect size in SOURCE argument to RESHAPE" ! " intrinsic: is %ld, should be %ld", ! (long int) source_extent, (long int) rs); ! ! if (order) ! { ! int seen[GFC_MAX_DIMENSIONS]; ! index_type v; ! ! for (n = 0; n < rdim; n++) ! seen[n] = 0; ! ! for (n = 0; n < rdim; n++) ! { ! v = order->data[n * order->dim[0].stride] - 1; ! ! if (v < 0 || v >= rdim) ! runtime_error("Value %ld out of range in ORDER argument" ! " to RESHAPE intrinsic", (long int) v + 1); ! ! if (seen[v] != 0) ! runtime_error("Duplicate value %ld in ORDER argument to" ! " RESHAPE intrinsic", (long int) v + 1); ! ! seen[v] = 1; ! } ! } } rsize = 1; *************** reshape_r4 (gfc_array_r4 * const restric *** 115,122 **** rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; ! if (rextent[n] != shape->data[dim * shape->dim[0].stride]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) --- 211,220 ---- rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + if (rextent[n] < 0) + rextent[n] = 0; ! if (rextent[n] != shape_data[dim]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) *************** reshape_r4 (gfc_array_r4 * const restric *** 147,183 **** ssize = 0; } - if (pad) - { - pdim = GFC_DESCRIPTOR_RANK (pad); - psize = 1; - pempty = 0; - for (n = 0; n < pdim; n++) - { - pcount[n] = 0; - pstride[n] = pad->dim[n].stride; - pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; - if (pextent[n] <= 0) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_REAL_4); --- 245,250 ---- diff -Nrcpad gcc-4.3.3/libgfortran/generated/reshape_r8.c gcc-4.4.0/libgfortran/generated/reshape_r8.c *** gcc-4.3.3/libgfortran/generated/reshape_r8.c Sun Nov 23 15:08:32 2008 --- gcc-4.4.0/libgfortran/generated/reshape_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** reshape_r8 (gfc_array_r8 * const restric *** 81,96 **** const GFC_REAL_8 *src; int n; int dim; ! int sempty, pempty; if (ret->data == NULL) { - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape->data[n * shape->dim[0].stride]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; --- 76,107 ---- const GFC_REAL_8 *src; int n; int dim; ! int sempty, pempty, shape_empty; ! index_type shape_data[GFC_MAX_DIMENSIONS]; ! ! rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; ! if (rdim != GFC_DESCRIPTOR_RANK(ret)) ! runtime_error("rank of return array incorrect in RESHAPE intrinsic"); ! ! shape_empty = 0; ! ! for (n = 0; n < rdim; n++) ! { ! shape_data[n] = shape->data[n * shape->dim[0].stride]; ! if (shape_data[n] <= 0) ! { ! shape_data[n] = 0; ! shape_empty = 1; ! } ! } if (ret->data == NULL) { rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape_data[n]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; *************** reshape_r8 (gfc_array_r8 * const restric *** 99,107 **** ret->data = internal_malloc_size ( rs * sizeof (GFC_REAL_8)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } else { ! rdim = GFC_DESCRIPTOR_RANK (ret); } rsize = 1; --- 110,203 ---- ret->data = internal_malloc_size ( rs * sizeof (GFC_REAL_8)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } else { ! pdim = 0; ! psize = 1; ! pempty = 1; ! pptr = NULL; ! } ! ! if (unlikely (compile_options.bounds_check)) ! { ! index_type ret_extent, source_extent; ! ! rs = 1; ! for (n = 0; n < rdim; n++) ! { ! rs *= shape_data[n]; ! ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; ! if (ret_extent != shape_data[n]) ! runtime_error("Incorrect extent in return value of RESHAPE" ! " intrinsic in dimension %ld: is %ld," ! " should be %ld", (long int) n+1, ! (long int) ret_extent, (long int) shape_data[n]); ! } ! ! source_extent = 1; ! sdim = GFC_DESCRIPTOR_RANK (source); ! for (n = 0; n < sdim; n++) ! { ! index_type se; ! se = source->dim[n].ubound + 1 - source->dim[0].lbound; ! source_extent *= se > 0 ? se : 0; ! } ! ! if (rs > source_extent && (!pad || pempty)) ! runtime_error("Incorrect size in SOURCE argument to RESHAPE" ! " intrinsic: is %ld, should be %ld", ! (long int) source_extent, (long int) rs); ! ! if (order) ! { ! int seen[GFC_MAX_DIMENSIONS]; ! index_type v; ! ! for (n = 0; n < rdim; n++) ! seen[n] = 0; ! ! for (n = 0; n < rdim; n++) ! { ! v = order->data[n * order->dim[0].stride] - 1; ! ! if (v < 0 || v >= rdim) ! runtime_error("Value %ld out of range in ORDER argument" ! " to RESHAPE intrinsic", (long int) v + 1); ! ! if (seen[v] != 0) ! runtime_error("Duplicate value %ld in ORDER argument to" ! " RESHAPE intrinsic", (long int) v + 1); ! ! seen[v] = 1; ! } ! } } rsize = 1; *************** reshape_r8 (gfc_array_r8 * const restric *** 115,122 **** rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; ! if (rextent[n] != shape->data[dim * shape->dim[0].stride]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) --- 211,220 ---- rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + if (rextent[n] < 0) + rextent[n] = 0; ! if (rextent[n] != shape_data[dim]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) *************** reshape_r8 (gfc_array_r8 * const restric *** 147,183 **** ssize = 0; } - if (pad) - { - pdim = GFC_DESCRIPTOR_RANK (pad); - psize = 1; - pempty = 0; - for (n = 0; n < pdim; n++) - { - pcount[n] = 0; - pstride[n] = pad->dim[n].stride; - pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; - if (pextent[n] <= 0) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_REAL_8); --- 245,250 ---- diff -Nrcpad gcc-4.3.3/libgfortran/generated/rrspacing_r10.c gcc-4.4.0/libgfortran/generated/rrspacing_r10.c *** gcc-4.3.3/libgfortran/generated/rrspacing_r10.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/rrspacing_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RRSPACING intrinsic ! Copyright 2006, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the RRSPACING intrinsic ! Copyright 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/rrspacing_r16.c gcc-4.4.0/libgfortran/generated/rrspacing_r16.c *** gcc-4.3.3/libgfortran/generated/rrspacing_r16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/rrspacing_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RRSPACING intrinsic ! Copyright 2006, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the RRSPACING intrinsic ! Copyright 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/rrspacing_r4.c gcc-4.4.0/libgfortran/generated/rrspacing_r4.c *** gcc-4.3.3/libgfortran/generated/rrspacing_r4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/rrspacing_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RRSPACING intrinsic ! Copyright 2006, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the RRSPACING intrinsic ! Copyright 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/rrspacing_r8.c gcc-4.4.0/libgfortran/generated/rrspacing_r8.c *** gcc-4.3.3/libgfortran/generated/rrspacing_r8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/rrspacing_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RRSPACING intrinsic ! Copyright 2006, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the RRSPACING intrinsic ! Copyright 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/set_exponent_r10.c gcc-4.4.0/libgfortran/generated/set_exponent_r10.c *** gcc-4.3.3/libgfortran/generated/set_exponent_r10.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/set_exponent_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SET_EXPONENT intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SET_EXPONENT intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/set_exponent_r16.c gcc-4.4.0/libgfortran/generated/set_exponent_r16.c *** gcc-4.3.3/libgfortran/generated/set_exponent_r16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/set_exponent_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SET_EXPONENT intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SET_EXPONENT intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/set_exponent_r4.c gcc-4.4.0/libgfortran/generated/set_exponent_r4.c *** gcc-4.3.3/libgfortran/generated/set_exponent_r4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/set_exponent_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SET_EXPONENT intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SET_EXPONENT intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/set_exponent_r8.c gcc-4.4.0/libgfortran/generated/set_exponent_r8.c *** gcc-4.3.3/libgfortran/generated/set_exponent_r8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/set_exponent_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SET_EXPONENT intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SET_EXPONENT intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/shape_i16.c gcc-4.4.0/libgfortran/generated/shape_i16.c *** gcc-4.3.3/libgfortran/generated/shape_i16.c Sat Feb 2 13:50:55 2008 --- gcc-4.4.0/libgfortran/generated/shape_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SHAPE intrinsic ! Copyright 2002, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SHAPE intrinsic ! Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/generated/shape_i4.c gcc-4.4.0/libgfortran/generated/shape_i4.c *** gcc-4.3.3/libgfortran/generated/shape_i4.c Sat Feb 2 13:50:55 2008 --- gcc-4.4.0/libgfortran/generated/shape_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SHAPE intrinsic ! Copyright 2002, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SHAPE intrinsic ! Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/generated/shape_i8.c gcc-4.4.0/libgfortran/generated/shape_i8.c *** gcc-4.3.3/libgfortran/generated/shape_i8.c Sat Feb 2 13:50:55 2008 --- gcc-4.4.0/libgfortran/generated/shape_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SHAPE intrinsic ! Copyright 2002, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SHAPE intrinsic ! Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/generated/spacing_r10.c gcc-4.4.0/libgfortran/generated/spacing_r10.c *** gcc-4.3.3/libgfortran/generated/spacing_r10.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/spacing_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SPACING intrinsic ! Copyright 2006, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SPACING intrinsic ! Copyright 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/spacing_r16.c gcc-4.4.0/libgfortran/generated/spacing_r16.c *** gcc-4.3.3/libgfortran/generated/spacing_r16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/spacing_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SPACING intrinsic ! Copyright 2006, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SPACING intrinsic ! Copyright 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/spacing_r4.c gcc-4.4.0/libgfortran/generated/spacing_r4.c *** gcc-4.3.3/libgfortran/generated/spacing_r4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/spacing_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SPACING intrinsic ! Copyright 2006, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SPACING intrinsic ! Copyright 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/spacing_r8.c gcc-4.4.0/libgfortran/generated/spacing_r8.c *** gcc-4.3.3/libgfortran/generated/spacing_r8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/spacing_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SPACING intrinsic ! Copyright 2006, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SPACING intrinsic ! Copyright 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/generated/spread_c10.c gcc-4.4.0/libgfortran/generated/spread_c10.c *** gcc-4.3.3/libgfortran/generated/spread_c10.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/spread_c10.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,273 ---- + /* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_COMPLEX_10) + + void + spread_c10 (gfc_array_c10 *ret, const gfc_array_c10 *source, + const index_type along, const index_type pncopies) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_COMPLEX_10 *rptr; + GFC_COMPLEX_10 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_COMPLEX_10 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + if (n == along - 1) + { + ret->dim[n].ubound = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = rs; + + ret->dim[n].ubound = extent[dim]-1; + rs *= extent[dim]; + dim++; + } + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_COMPLEX_10)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } + } + + /* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + + void + spread_scalar_c10 (gfc_array_c10 *ret, const GFC_COMPLEX_10 *source, + const index_type along, const index_type pncopies) + { + int n; + int ncopies = pncopies; + GFC_COMPLEX_10 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_COMPLEX_10)); + ret->offset = 0; + ret->dim[0].stride = 1; + ret->dim[0].lbound = 0; + ret->dim[0].ubound = ncopies - 1; + } + else + { + if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) + / ret->dim[0].stride) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = ret->dim[0].stride; + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/spread_c16.c gcc-4.4.0/libgfortran/generated/spread_c16.c *** gcc-4.3.3/libgfortran/generated/spread_c16.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/spread_c16.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,273 ---- + /* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_COMPLEX_16) + + void + spread_c16 (gfc_array_c16 *ret, const gfc_array_c16 *source, + const index_type along, const index_type pncopies) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_COMPLEX_16 *rptr; + GFC_COMPLEX_16 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_COMPLEX_16 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + if (n == along - 1) + { + ret->dim[n].ubound = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = rs; + + ret->dim[n].ubound = extent[dim]-1; + rs *= extent[dim]; + dim++; + } + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_COMPLEX_16)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } + } + + /* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + + void + spread_scalar_c16 (gfc_array_c16 *ret, const GFC_COMPLEX_16 *source, + const index_type along, const index_type pncopies) + { + int n; + int ncopies = pncopies; + GFC_COMPLEX_16 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_COMPLEX_16)); + ret->offset = 0; + ret->dim[0].stride = 1; + ret->dim[0].lbound = 0; + ret->dim[0].ubound = ncopies - 1; + } + else + { + if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) + / ret->dim[0].stride) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = ret->dim[0].stride; + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/spread_c4.c gcc-4.4.0/libgfortran/generated/spread_c4.c *** gcc-4.3.3/libgfortran/generated/spread_c4.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/spread_c4.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,273 ---- + /* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_COMPLEX_4) + + void + spread_c4 (gfc_array_c4 *ret, const gfc_array_c4 *source, + const index_type along, const index_type pncopies) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_COMPLEX_4 *rptr; + GFC_COMPLEX_4 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_COMPLEX_4 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + if (n == along - 1) + { + ret->dim[n].ubound = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = rs; + + ret->dim[n].ubound = extent[dim]-1; + rs *= extent[dim]; + dim++; + } + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_COMPLEX_4)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } + } + + /* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + + void + spread_scalar_c4 (gfc_array_c4 *ret, const GFC_COMPLEX_4 *source, + const index_type along, const index_type pncopies) + { + int n; + int ncopies = pncopies; + GFC_COMPLEX_4 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_COMPLEX_4)); + ret->offset = 0; + ret->dim[0].stride = 1; + ret->dim[0].lbound = 0; + ret->dim[0].ubound = ncopies - 1; + } + else + { + if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) + / ret->dim[0].stride) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = ret->dim[0].stride; + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/spread_c8.c gcc-4.4.0/libgfortran/generated/spread_c8.c *** gcc-4.3.3/libgfortran/generated/spread_c8.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/spread_c8.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,273 ---- + /* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_COMPLEX_8) + + void + spread_c8 (gfc_array_c8 *ret, const gfc_array_c8 *source, + const index_type along, const index_type pncopies) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_COMPLEX_8 *rptr; + GFC_COMPLEX_8 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_COMPLEX_8 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + if (n == along - 1) + { + ret->dim[n].ubound = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = rs; + + ret->dim[n].ubound = extent[dim]-1; + rs *= extent[dim]; + dim++; + } + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_COMPLEX_8)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } + } + + /* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + + void + spread_scalar_c8 (gfc_array_c8 *ret, const GFC_COMPLEX_8 *source, + const index_type along, const index_type pncopies) + { + int n; + int ncopies = pncopies; + GFC_COMPLEX_8 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_COMPLEX_8)); + ret->offset = 0; + ret->dim[0].stride = 1; + ret->dim[0].lbound = 0; + ret->dim[0].ubound = ncopies - 1; + } + else + { + if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) + / ret->dim[0].stride) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = ret->dim[0].stride; + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/spread_i1.c gcc-4.4.0/libgfortran/generated/spread_i1.c *** gcc-4.3.3/libgfortran/generated/spread_i1.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/spread_i1.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,273 ---- + /* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_1) + + void + spread_i1 (gfc_array_i1 *ret, const gfc_array_i1 *source, + const index_type along, const index_type pncopies) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_INTEGER_1 *rptr; + GFC_INTEGER_1 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_INTEGER_1 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + if (n == along - 1) + { + ret->dim[n].ubound = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = rs; + + ret->dim[n].ubound = extent[dim]-1; + rs *= extent[dim]; + dim++; + } + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_INTEGER_1)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } + } + + /* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + + void + spread_scalar_i1 (gfc_array_i1 *ret, const GFC_INTEGER_1 *source, + const index_type along, const index_type pncopies) + { + int n; + int ncopies = pncopies; + GFC_INTEGER_1 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_1)); + ret->offset = 0; + ret->dim[0].stride = 1; + ret->dim[0].lbound = 0; + ret->dim[0].ubound = ncopies - 1; + } + else + { + if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) + / ret->dim[0].stride) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = ret->dim[0].stride; + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/spread_i16.c gcc-4.4.0/libgfortran/generated/spread_i16.c *** gcc-4.3.3/libgfortran/generated/spread_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/spread_i16.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,273 ---- + /* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_16) + + void + spread_i16 (gfc_array_i16 *ret, const gfc_array_i16 *source, + const index_type along, const index_type pncopies) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_INTEGER_16 *rptr; + GFC_INTEGER_16 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_INTEGER_16 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + if (n == along - 1) + { + ret->dim[n].ubound = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = rs; + + ret->dim[n].ubound = extent[dim]-1; + rs *= extent[dim]; + dim++; + } + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_INTEGER_16)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } + } + + /* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + + void + spread_scalar_i16 (gfc_array_i16 *ret, const GFC_INTEGER_16 *source, + const index_type along, const index_type pncopies) + { + int n; + int ncopies = pncopies; + GFC_INTEGER_16 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_16)); + ret->offset = 0; + ret->dim[0].stride = 1; + ret->dim[0].lbound = 0; + ret->dim[0].ubound = ncopies - 1; + } + else + { + if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) + / ret->dim[0].stride) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = ret->dim[0].stride; + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/spread_i2.c gcc-4.4.0/libgfortran/generated/spread_i2.c *** gcc-4.3.3/libgfortran/generated/spread_i2.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/spread_i2.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,273 ---- + /* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_2) + + void + spread_i2 (gfc_array_i2 *ret, const gfc_array_i2 *source, + const index_type along, const index_type pncopies) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_INTEGER_2 *rptr; + GFC_INTEGER_2 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_INTEGER_2 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + if (n == along - 1) + { + ret->dim[n].ubound = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = rs; + + ret->dim[n].ubound = extent[dim]-1; + rs *= extent[dim]; + dim++; + } + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_INTEGER_2)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } + } + + /* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + + void + spread_scalar_i2 (gfc_array_i2 *ret, const GFC_INTEGER_2 *source, + const index_type along, const index_type pncopies) + { + int n; + int ncopies = pncopies; + GFC_INTEGER_2 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_2)); + ret->offset = 0; + ret->dim[0].stride = 1; + ret->dim[0].lbound = 0; + ret->dim[0].ubound = ncopies - 1; + } + else + { + if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) + / ret->dim[0].stride) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = ret->dim[0].stride; + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/spread_i4.c gcc-4.4.0/libgfortran/generated/spread_i4.c *** gcc-4.3.3/libgfortran/generated/spread_i4.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/spread_i4.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,273 ---- + /* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_4) + + void + spread_i4 (gfc_array_i4 *ret, const gfc_array_i4 *source, + const index_type along, const index_type pncopies) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_INTEGER_4 *rptr; + GFC_INTEGER_4 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_INTEGER_4 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + if (n == along - 1) + { + ret->dim[n].ubound = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = rs; + + ret->dim[n].ubound = extent[dim]-1; + rs *= extent[dim]; + dim++; + } + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_INTEGER_4)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } + } + + /* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + + void + spread_scalar_i4 (gfc_array_i4 *ret, const GFC_INTEGER_4 *source, + const index_type along, const index_type pncopies) + { + int n; + int ncopies = pncopies; + GFC_INTEGER_4 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_4)); + ret->offset = 0; + ret->dim[0].stride = 1; + ret->dim[0].lbound = 0; + ret->dim[0].ubound = ncopies - 1; + } + else + { + if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) + / ret->dim[0].stride) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = ret->dim[0].stride; + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/spread_i8.c gcc-4.4.0/libgfortran/generated/spread_i8.c *** gcc-4.3.3/libgfortran/generated/spread_i8.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/spread_i8.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,273 ---- + /* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_8) + + void + spread_i8 (gfc_array_i8 *ret, const gfc_array_i8 *source, + const index_type along, const index_type pncopies) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_INTEGER_8 *rptr; + GFC_INTEGER_8 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_INTEGER_8 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + if (n == along - 1) + { + ret->dim[n].ubound = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = rs; + + ret->dim[n].ubound = extent[dim]-1; + rs *= extent[dim]; + dim++; + } + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_INTEGER_8)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } + } + + /* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + + void + spread_scalar_i8 (gfc_array_i8 *ret, const GFC_INTEGER_8 *source, + const index_type along, const index_type pncopies) + { + int n; + int ncopies = pncopies; + GFC_INTEGER_8 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_8)); + ret->offset = 0; + ret->dim[0].stride = 1; + ret->dim[0].lbound = 0; + ret->dim[0].ubound = ncopies - 1; + } + else + { + if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) + / ret->dim[0].stride) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = ret->dim[0].stride; + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/spread_r10.c gcc-4.4.0/libgfortran/generated/spread_r10.c *** gcc-4.3.3/libgfortran/generated/spread_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/spread_r10.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,273 ---- + /* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_10) + + void + spread_r10 (gfc_array_r10 *ret, const gfc_array_r10 *source, + const index_type along, const index_type pncopies) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_REAL_10 *rptr; + GFC_REAL_10 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_REAL_10 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + if (n == along - 1) + { + ret->dim[n].ubound = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = rs; + + ret->dim[n].ubound = extent[dim]-1; + rs *= extent[dim]; + dim++; + } + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_REAL_10)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } + } + + /* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + + void + spread_scalar_r10 (gfc_array_r10 *ret, const GFC_REAL_10 *source, + const index_type along, const index_type pncopies) + { + int n; + int ncopies = pncopies; + GFC_REAL_10 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_REAL_10)); + ret->offset = 0; + ret->dim[0].stride = 1; + ret->dim[0].lbound = 0; + ret->dim[0].ubound = ncopies - 1; + } + else + { + if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) + / ret->dim[0].stride) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = ret->dim[0].stride; + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/spread_r16.c gcc-4.4.0/libgfortran/generated/spread_r16.c *** gcc-4.3.3/libgfortran/generated/spread_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/spread_r16.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,273 ---- + /* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_16) + + void + spread_r16 (gfc_array_r16 *ret, const gfc_array_r16 *source, + const index_type along, const index_type pncopies) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_REAL_16 *rptr; + GFC_REAL_16 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_REAL_16 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + if (n == along - 1) + { + ret->dim[n].ubound = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = rs; + + ret->dim[n].ubound = extent[dim]-1; + rs *= extent[dim]; + dim++; + } + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_REAL_16)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } + } + + /* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + + void + spread_scalar_r16 (gfc_array_r16 *ret, const GFC_REAL_16 *source, + const index_type along, const index_type pncopies) + { + int n; + int ncopies = pncopies; + GFC_REAL_16 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_REAL_16)); + ret->offset = 0; + ret->dim[0].stride = 1; + ret->dim[0].lbound = 0; + ret->dim[0].ubound = ncopies - 1; + } + else + { + if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) + / ret->dim[0].stride) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = ret->dim[0].stride; + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/spread_r4.c gcc-4.4.0/libgfortran/generated/spread_r4.c *** gcc-4.3.3/libgfortran/generated/spread_r4.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/spread_r4.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,273 ---- + /* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_4) + + void + spread_r4 (gfc_array_r4 *ret, const gfc_array_r4 *source, + const index_type along, const index_type pncopies) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_REAL_4 *rptr; + GFC_REAL_4 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_REAL_4 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + if (n == along - 1) + { + ret->dim[n].ubound = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = rs; + + ret->dim[n].ubound = extent[dim]-1; + rs *= extent[dim]; + dim++; + } + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_REAL_4)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } + } + + /* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + + void + spread_scalar_r4 (gfc_array_r4 *ret, const GFC_REAL_4 *source, + const index_type along, const index_type pncopies) + { + int n; + int ncopies = pncopies; + GFC_REAL_4 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_REAL_4)); + ret->offset = 0; + ret->dim[0].stride = 1; + ret->dim[0].lbound = 0; + ret->dim[0].ubound = ncopies - 1; + } + else + { + if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) + / ret->dim[0].stride) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = ret->dim[0].stride; + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/spread_r8.c gcc-4.4.0/libgfortran/generated/spread_r8.c *** gcc-4.3.3/libgfortran/generated/spread_r8.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/spread_r8.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,273 ---- + /* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_8) + + void + spread_r8 (gfc_array_r8 *ret, const gfc_array_r8 *source, + const index_type along, const index_type pncopies) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_REAL_8 *rptr; + GFC_REAL_8 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_REAL_8 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + if (n == along - 1) + { + ret->dim[n].ubound = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = rs; + + ret->dim[n].ubound = extent[dim]-1; + rs *= extent[dim]; + dim++; + } + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_REAL_8)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } + } + + /* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + + void + spread_scalar_r8 (gfc_array_r8 *ret, const GFC_REAL_8 *source, + const index_type along, const index_type pncopies) + { + int n; + int ncopies = pncopies; + GFC_REAL_8 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_REAL_8)); + ret->offset = 0; + ret->dim[0].stride = 1; + ret->dim[0].lbound = 0; + ret->dim[0].ubound = ncopies - 1; + } + else + { + if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) + / ret->dim[0].stride) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = ret->dim[0].stride; + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/sum_c10.c gcc-4.4.0/libgfortran/generated/sum_c10.c *** gcc-4.3.3/libgfortran/generated/sum_c10.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/sum_c10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SUM intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SUM intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** sum_c10 (gfc_array_c10 * const restrict *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** msum_c10 (gfc_array_c10 * const restrict *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** ssum_c10 (gfc_array_c10 * const restrict *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/sum_c16.c gcc-4.4.0/libgfortran/generated/sum_c16.c *** gcc-4.3.3/libgfortran/generated/sum_c16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/sum_c16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SUM intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SUM intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** sum_c16 (gfc_array_c16 * const restrict *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** msum_c16 (gfc_array_c16 * const restrict *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** ssum_c16 (gfc_array_c16 * const restrict *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/sum_c4.c gcc-4.4.0/libgfortran/generated/sum_c4.c *** gcc-4.3.3/libgfortran/generated/sum_c4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/sum_c4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SUM intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SUM intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** sum_c4 (gfc_array_c4 * const restrict re *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** msum_c4 (gfc_array_c4 * const restrict r *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** ssum_c4 (gfc_array_c4 * const restrict r *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/sum_c8.c gcc-4.4.0/libgfortran/generated/sum_c8.c *** gcc-4.3.3/libgfortran/generated/sum_c8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/sum_c8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SUM intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SUM intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** sum_c8 (gfc_array_c8 * const restrict re *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** msum_c8 (gfc_array_c8 * const restrict r *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** ssum_c8 (gfc_array_c8 * const restrict r *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/sum_i1.c gcc-4.4.0/libgfortran/generated/sum_i1.c *** gcc-4.3.3/libgfortran/generated/sum_i1.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/sum_i1.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SUM intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SUM intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** sum_i1 (gfc_array_i1 * const restrict re *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** msum_i1 (gfc_array_i1 * const restrict r *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** ssum_i1 (gfc_array_i1 * const restrict r *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/sum_i16.c gcc-4.4.0/libgfortran/generated/sum_i16.c *** gcc-4.3.3/libgfortran/generated/sum_i16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/sum_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SUM intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SUM intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** sum_i16 (gfc_array_i16 * const restrict *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** msum_i16 (gfc_array_i16 * const restrict *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** ssum_i16 (gfc_array_i16 * const restrict *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/sum_i2.c gcc-4.4.0/libgfortran/generated/sum_i2.c *** gcc-4.3.3/libgfortran/generated/sum_i2.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/sum_i2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SUM intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SUM intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** sum_i2 (gfc_array_i2 * const restrict re *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** msum_i2 (gfc_array_i2 * const restrict r *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** ssum_i2 (gfc_array_i2 * const restrict r *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/sum_i4.c gcc-4.4.0/libgfortran/generated/sum_i4.c *** gcc-4.3.3/libgfortran/generated/sum_i4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/sum_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SUM intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SUM intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** sum_i4 (gfc_array_i4 * const restrict re *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** msum_i4 (gfc_array_i4 * const restrict r *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** ssum_i4 (gfc_array_i4 * const restrict r *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/sum_i8.c gcc-4.4.0/libgfortran/generated/sum_i8.c *** gcc-4.3.3/libgfortran/generated/sum_i8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/sum_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SUM intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SUM intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** sum_i8 (gfc_array_i8 * const restrict re *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** msum_i8 (gfc_array_i8 * const restrict r *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** ssum_i8 (gfc_array_i8 * const restrict r *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/sum_r10.c gcc-4.4.0/libgfortran/generated/sum_r10.c *** gcc-4.3.3/libgfortran/generated/sum_r10.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/sum_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SUM intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SUM intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** sum_r10 (gfc_array_r10 * const restrict *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** msum_r10 (gfc_array_r10 * const restrict *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** ssum_r10 (gfc_array_r10 * const restrict *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/sum_r16.c gcc-4.4.0/libgfortran/generated/sum_r16.c *** gcc-4.3.3/libgfortran/generated/sum_r16.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/sum_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SUM intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SUM intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** sum_r16 (gfc_array_r16 * const restrict *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** msum_r16 (gfc_array_r16 * const restrict *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** ssum_r16 (gfc_array_r16 * const restrict *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/sum_r4.c gcc-4.4.0/libgfortran/generated/sum_r4.c *** gcc-4.3.3/libgfortran/generated/sum_r4.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/sum_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SUM intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SUM intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** sum_r4 (gfc_array_r4 * const restrict re *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** msum_r4 (gfc_array_r4 * const restrict r *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** ssum_r4 (gfc_array_r4 * const restrict r *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/sum_r8.c gcc-4.4.0/libgfortran/generated/sum_r8.c *** gcc-4.3.3/libgfortran/generated/sum_r8.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/generated/sum_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SUM intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SUM intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** sum_r8 (gfc_array_r8 * const restrict re *** 123,129 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 118,124 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** msum_r8 (gfc_array_r8 * const restrict r *** 311,317 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 306,312 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in SUM intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** ssum_r8 (gfc_array_r8 * const restrict r *** 496,502 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 491,497 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/generated/transpose_c10.c gcc-4.4.0/libgfortran/generated/transpose_c10.c *** gcc-4.3.3/libgfortran/generated/transpose_c10.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/transpose_c10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** transpose_c10 (gfc_array_c10 * const res *** 44,50 **** { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_COMPLEX_10 *rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_COMPLEX_10 *sptr; --- 39,45 ---- { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_COMPLEX_10 * restrict rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_COMPLEX_10 *sptr; *************** transpose_c10 (gfc_array_c10 * const res *** 69,74 **** --- 64,91 ---- ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_10) * size0 ((array_t *) ret)); ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; + src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + } sxstride = source->dim[0].stride; diff -Nrcpad gcc-4.3.3/libgfortran/generated/transpose_c16.c gcc-4.4.0/libgfortran/generated/transpose_c16.c *** gcc-4.3.3/libgfortran/generated/transpose_c16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/transpose_c16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** transpose_c16 (gfc_array_c16 * const res *** 44,50 **** { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_COMPLEX_16 *rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_COMPLEX_16 *sptr; --- 39,45 ---- { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_COMPLEX_16 * restrict rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_COMPLEX_16 *sptr; *************** transpose_c16 (gfc_array_c16 * const res *** 69,74 **** --- 64,91 ---- ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_16) * size0 ((array_t *) ret)); ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; + src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + } sxstride = source->dim[0].stride; diff -Nrcpad gcc-4.3.3/libgfortran/generated/transpose_c4.c gcc-4.4.0/libgfortran/generated/transpose_c4.c *** gcc-4.3.3/libgfortran/generated/transpose_c4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/transpose_c4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** transpose_c4 (gfc_array_c4 * const restr *** 44,50 **** { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_COMPLEX_4 *rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_COMPLEX_4 *sptr; --- 39,45 ---- { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_COMPLEX_4 * restrict rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_COMPLEX_4 *sptr; *************** transpose_c4 (gfc_array_c4 * const restr *** 69,74 **** --- 64,91 ---- ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_4) * size0 ((array_t *) ret)); ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; + src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + } sxstride = source->dim[0].stride; diff -Nrcpad gcc-4.3.3/libgfortran/generated/transpose_c8.c gcc-4.4.0/libgfortran/generated/transpose_c8.c *** gcc-4.3.3/libgfortran/generated/transpose_c8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/transpose_c8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** transpose_c8 (gfc_array_c8 * const restr *** 44,50 **** { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_COMPLEX_8 *rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_COMPLEX_8 *sptr; --- 39,45 ---- { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_COMPLEX_8 * restrict rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_COMPLEX_8 *sptr; *************** transpose_c8 (gfc_array_c8 * const restr *** 69,74 **** --- 64,91 ---- ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_8) * size0 ((array_t *) ret)); ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; + src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + } sxstride = source->dim[0].stride; diff -Nrcpad gcc-4.3.3/libgfortran/generated/transpose_i16.c gcc-4.4.0/libgfortran/generated/transpose_i16.c *** gcc-4.3.3/libgfortran/generated/transpose_i16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/transpose_i16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** transpose_i16 (gfc_array_i16 * const res *** 44,50 **** { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_INTEGER_16 *rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_INTEGER_16 *sptr; --- 39,45 ---- { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_INTEGER_16 * restrict rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_INTEGER_16 *sptr; *************** transpose_i16 (gfc_array_i16 * const res *** 69,74 **** --- 64,91 ---- ret->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * size0 ((array_t *) ret)); ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; + src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + } sxstride = source->dim[0].stride; diff -Nrcpad gcc-4.3.3/libgfortran/generated/transpose_i4.c gcc-4.4.0/libgfortran/generated/transpose_i4.c *** gcc-4.3.3/libgfortran/generated/transpose_i4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/transpose_i4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** transpose_i4 (gfc_array_i4 * const restr *** 44,50 **** { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_INTEGER_4 *rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_INTEGER_4 *sptr; --- 39,45 ---- { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_INTEGER_4 * restrict rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_INTEGER_4 *sptr; *************** transpose_i4 (gfc_array_i4 * const restr *** 69,74 **** --- 64,91 ---- ret->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * size0 ((array_t *) ret)); ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; + src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + } sxstride = source->dim[0].stride; diff -Nrcpad gcc-4.3.3/libgfortran/generated/transpose_i8.c gcc-4.4.0/libgfortran/generated/transpose_i8.c *** gcc-4.3.3/libgfortran/generated/transpose_i8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/transpose_i8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** transpose_i8 (gfc_array_i8 * const restr *** 44,50 **** { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_INTEGER_8 *rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_INTEGER_8 *sptr; --- 39,45 ---- { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_INTEGER_8 * restrict rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_INTEGER_8 *sptr; *************** transpose_i8 (gfc_array_i8 * const restr *** 69,74 **** --- 64,91 ---- ret->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * size0 ((array_t *) ret)); ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; + src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + } sxstride = source->dim[0].stride; diff -Nrcpad gcc-4.3.3/libgfortran/generated/transpose_r10.c gcc-4.4.0/libgfortran/generated/transpose_r10.c *** gcc-4.3.3/libgfortran/generated/transpose_r10.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/transpose_r10.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** transpose_r10 (gfc_array_r10 * const res *** 44,50 **** { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_REAL_10 *rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_REAL_10 *sptr; --- 39,45 ---- { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_REAL_10 * restrict rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_REAL_10 *sptr; *************** transpose_r10 (gfc_array_r10 * const res *** 69,74 **** --- 64,91 ---- ret->data = internal_malloc_size (sizeof (GFC_REAL_10) * size0 ((array_t *) ret)); ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; + src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + } sxstride = source->dim[0].stride; diff -Nrcpad gcc-4.3.3/libgfortran/generated/transpose_r16.c gcc-4.4.0/libgfortran/generated/transpose_r16.c *** gcc-4.3.3/libgfortran/generated/transpose_r16.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/transpose_r16.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** transpose_r16 (gfc_array_r16 * const res *** 44,50 **** { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_REAL_16 *rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_REAL_16 *sptr; --- 39,45 ---- { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_REAL_16 * restrict rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_REAL_16 *sptr; *************** transpose_r16 (gfc_array_r16 * const res *** 69,74 **** --- 64,91 ---- ret->data = internal_malloc_size (sizeof (GFC_REAL_16) * size0 ((array_t *) ret)); ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; + src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + } sxstride = source->dim[0].stride; diff -Nrcpad gcc-4.3.3/libgfortran/generated/transpose_r4.c gcc-4.4.0/libgfortran/generated/transpose_r4.c *** gcc-4.3.3/libgfortran/generated/transpose_r4.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/transpose_r4.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** transpose_r4 (gfc_array_r4 * const restr *** 44,50 **** { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_REAL_4 *rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_REAL_4 *sptr; --- 39,45 ---- { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_REAL_4 * restrict rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_REAL_4 *sptr; *************** transpose_r4 (gfc_array_r4 * const restr *** 69,74 **** --- 64,91 ---- ret->data = internal_malloc_size (sizeof (GFC_REAL_4) * size0 ((array_t *) ret)); ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; + src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + } sxstride = source->dim[0].stride; diff -Nrcpad gcc-4.3.3/libgfortran/generated/transpose_r8.c gcc-4.4.0/libgfortran/generated/transpose_r8.c *** gcc-4.3.3/libgfortran/generated/transpose_r8.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/generated/transpose_r8.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** transpose_r8 (gfc_array_r8 * const restr *** 44,50 **** { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_REAL_8 *rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_REAL_8 *sptr; --- 39,45 ---- { /* r.* indicates the return array. */ index_type rxstride, rystride; ! GFC_REAL_8 * restrict rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const GFC_REAL_8 *sptr; *************** transpose_r8 (gfc_array_r8 * const restr *** 69,74 **** --- 64,91 ---- ret->data = internal_malloc_size (sizeof (GFC_REAL_8) * size0 ((array_t *) ret)); ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; + src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + } sxstride = source->dim[0].stride; diff -Nrcpad gcc-4.3.3/libgfortran/generated/unpack_c10.c gcc-4.4.0/libgfortran/generated/unpack_c10.c *** gcc-4.3.3/libgfortran/generated/unpack_c10.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/unpack_c10.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,333 ---- + /* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c by Paul Brook . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_COMPLEX_10) + + void + unpack0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, + const gfc_array_l1 *mask, const GFC_COMPLEX_10 *fptr) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_COMPLEX_10 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_COMPLEX_10 *vptr; + /* Value for field, this is constant. */ + const GFC_COMPLEX_10 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_COMPLEX_10)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } + } + + void + unpack1_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, + const gfc_array_l1 *mask, const gfc_array_c10 *field) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_COMPLEX_10 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_COMPLEX_10 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_COMPLEX_10 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_COMPLEX_10)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/unpack_c16.c gcc-4.4.0/libgfortran/generated/unpack_c16.c *** gcc-4.3.3/libgfortran/generated/unpack_c16.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/unpack_c16.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,333 ---- + /* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c by Paul Brook . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_COMPLEX_16) + + void + unpack0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, + const gfc_array_l1 *mask, const GFC_COMPLEX_16 *fptr) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_COMPLEX_16 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_COMPLEX_16 *vptr; + /* Value for field, this is constant. */ + const GFC_COMPLEX_16 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_COMPLEX_16)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } + } + + void + unpack1_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, + const gfc_array_l1 *mask, const gfc_array_c16 *field) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_COMPLEX_16 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_COMPLEX_16 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_COMPLEX_16 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_COMPLEX_16)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/unpack_c4.c gcc-4.4.0/libgfortran/generated/unpack_c4.c *** gcc-4.3.3/libgfortran/generated/unpack_c4.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/unpack_c4.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,333 ---- + /* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c by Paul Brook . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_COMPLEX_4) + + void + unpack0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, + const gfc_array_l1 *mask, const GFC_COMPLEX_4 *fptr) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_COMPLEX_4 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_COMPLEX_4 *vptr; + /* Value for field, this is constant. */ + const GFC_COMPLEX_4 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_COMPLEX_4)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } + } + + void + unpack1_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, + const gfc_array_l1 *mask, const gfc_array_c4 *field) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_COMPLEX_4 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_COMPLEX_4 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_COMPLEX_4 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_COMPLEX_4)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/unpack_c8.c gcc-4.4.0/libgfortran/generated/unpack_c8.c *** gcc-4.3.3/libgfortran/generated/unpack_c8.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/unpack_c8.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,333 ---- + /* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c by Paul Brook . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_COMPLEX_8) + + void + unpack0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, + const gfc_array_l1 *mask, const GFC_COMPLEX_8 *fptr) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_COMPLEX_8 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_COMPLEX_8 *vptr; + /* Value for field, this is constant. */ + const GFC_COMPLEX_8 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_COMPLEX_8)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } + } + + void + unpack1_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, + const gfc_array_l1 *mask, const gfc_array_c8 *field) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_COMPLEX_8 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_COMPLEX_8 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_COMPLEX_8 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_COMPLEX_8)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/unpack_i1.c gcc-4.4.0/libgfortran/generated/unpack_i1.c *** gcc-4.3.3/libgfortran/generated/unpack_i1.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/unpack_i1.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,333 ---- + /* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c by Paul Brook . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_1) + + void + unpack0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, + const gfc_array_l1 *mask, const GFC_INTEGER_1 *fptr) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_1 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_1 *vptr; + /* Value for field, this is constant. */ + const GFC_INTEGER_1 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_1)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } + } + + void + unpack1_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, + const gfc_array_l1 *mask, const gfc_array_i1 *field) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_1 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_1 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_INTEGER_1 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_1)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/unpack_i16.c gcc-4.4.0/libgfortran/generated/unpack_i16.c *** gcc-4.3.3/libgfortran/generated/unpack_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/unpack_i16.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,333 ---- + /* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c by Paul Brook . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_16) + + void + unpack0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, + const gfc_array_l1 *mask, const GFC_INTEGER_16 *fptr) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_16 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_16 *vptr; + /* Value for field, this is constant. */ + const GFC_INTEGER_16 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_16)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } + } + + void + unpack1_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, + const gfc_array_l1 *mask, const gfc_array_i16 *field) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_16 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_16 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_INTEGER_16 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_16)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/unpack_i2.c gcc-4.4.0/libgfortran/generated/unpack_i2.c *** gcc-4.3.3/libgfortran/generated/unpack_i2.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/unpack_i2.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,333 ---- + /* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c by Paul Brook . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_2) + + void + unpack0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, + const gfc_array_l1 *mask, const GFC_INTEGER_2 *fptr) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_2 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_2 *vptr; + /* Value for field, this is constant. */ + const GFC_INTEGER_2 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_2)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } + } + + void + unpack1_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, + const gfc_array_l1 *mask, const gfc_array_i2 *field) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_2 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_2 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_INTEGER_2 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_2)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/unpack_i4.c gcc-4.4.0/libgfortran/generated/unpack_i4.c *** gcc-4.3.3/libgfortran/generated/unpack_i4.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/unpack_i4.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,333 ---- + /* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c by Paul Brook . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_4) + + void + unpack0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, + const gfc_array_l1 *mask, const GFC_INTEGER_4 *fptr) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_4 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_4 *vptr; + /* Value for field, this is constant. */ + const GFC_INTEGER_4 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_4)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } + } + + void + unpack1_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, + const gfc_array_l1 *mask, const gfc_array_i4 *field) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_4 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_4 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_INTEGER_4 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_4)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/unpack_i8.c gcc-4.4.0/libgfortran/generated/unpack_i8.c *** gcc-4.3.3/libgfortran/generated/unpack_i8.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/unpack_i8.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,333 ---- + /* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c by Paul Brook . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_INTEGER_8) + + void + unpack0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, + const gfc_array_l1 *mask, const GFC_INTEGER_8 *fptr) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_8 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_8 *vptr; + /* Value for field, this is constant. */ + const GFC_INTEGER_8 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_8)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } + } + + void + unpack1_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, + const gfc_array_l1 *mask, const gfc_array_i8 *field) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_8 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_8 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_INTEGER_8 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_8)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/unpack_r10.c gcc-4.4.0/libgfortran/generated/unpack_r10.c *** gcc-4.3.3/libgfortran/generated/unpack_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/unpack_r10.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,333 ---- + /* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c by Paul Brook . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_10) + + void + unpack0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, + const gfc_array_l1 *mask, const GFC_REAL_10 *fptr) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_REAL_10 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_REAL_10 *vptr; + /* Value for field, this is constant. */ + const GFC_REAL_10 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_10)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } + } + + void + unpack1_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, + const gfc_array_l1 *mask, const gfc_array_r10 *field) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_REAL_10 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_REAL_10 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_REAL_10 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_10)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/unpack_r16.c gcc-4.4.0/libgfortran/generated/unpack_r16.c *** gcc-4.3.3/libgfortran/generated/unpack_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/unpack_r16.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,333 ---- + /* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c by Paul Brook . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_16) + + void + unpack0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, + const gfc_array_l1 *mask, const GFC_REAL_16 *fptr) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_REAL_16 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_REAL_16 *vptr; + /* Value for field, this is constant. */ + const GFC_REAL_16 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_16)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } + } + + void + unpack1_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, + const gfc_array_l1 *mask, const gfc_array_r16 *field) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_REAL_16 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_REAL_16 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_REAL_16 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_16)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/unpack_r4.c gcc-4.4.0/libgfortran/generated/unpack_r4.c *** gcc-4.3.3/libgfortran/generated/unpack_r4.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/unpack_r4.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,333 ---- + /* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c by Paul Brook . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_4) + + void + unpack0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, + const gfc_array_l1 *mask, const GFC_REAL_4 *fptr) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_REAL_4 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_REAL_4 *vptr; + /* Value for field, this is constant. */ + const GFC_REAL_4 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_4)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } + } + + void + unpack1_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, + const gfc_array_l1 *mask, const gfc_array_r4 *field) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_REAL_4 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_REAL_4 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_REAL_4 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_4)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/generated/unpack_r8.c gcc-4.4.0/libgfortran/generated/unpack_r8.c *** gcc-4.3.3/libgfortran/generated/unpack_r8.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/generated/unpack_r8.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,333 ---- + /* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c by Paul Brook . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include + + + #if defined (HAVE_GFC_REAL_8) + + void + unpack0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, + const gfc_array_l1 *mask, const GFC_REAL_8 *fptr) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_REAL_8 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_REAL_8 *vptr; + /* Value for field, this is constant. */ + const GFC_REAL_8 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_8)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } + } + + void + unpack1_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, + const gfc_array_l1 *mask, const gfc_array_r8 *field) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_REAL_8 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_REAL_8 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_REAL_8 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_8)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } + } + + #endif + diff -Nrcpad gcc-4.3.3/libgfortran/gfortran.map gcc-4.4.0/libgfortran/gfortran.map *** gcc-4.3.3/libgfortran/gfortran.map Tue Jan 15 21:22:07 2008 --- gcc-4.4.0/libgfortran/gfortran.map Sun Jul 27 10:45:44 2008 *************** GFORTRAN_1.0 { *** 1026,1036 **** __iso_c_binding_c_f_pointer_l4; __iso_c_binding_c_f_pointer_l8; __iso_c_binding_c_f_pointer_u0; - __iso_c_binding_c_f_procpointer; local: *; }; F2C_1.0 { global: _gfortran_f2c_specific__abs_c4; --- 1026,1095 ---- __iso_c_binding_c_f_pointer_l4; __iso_c_binding_c_f_pointer_l8; __iso_c_binding_c_f_pointer_u0; local: *; }; + GFORTRAN_1.1 { + global: + _gfortran_adjustl_char4; + _gfortran_adjustr_char4; + _gfortran_compare_string_char4; + _gfortran_concat_string_char4; + _gfortran_convert_char1_to_char4; + _gfortran_convert_char4_to_char1; + _gfortran_cshift0_16; + _gfortran_cshift0_16_char; + _gfortran_cshift0_1_char4; + _gfortran_cshift0_2_char4; + _gfortran_cshift0_4_char4; + _gfortran_cshift0_8_char4; + _gfortran_cshift1_16_char4; + _gfortran_cshift1_4_char4; + _gfortran_cshift1_8_char4; + _gfortran_eoshift0_16; + _gfortran_eoshift0_16_char; + _gfortran_eoshift0_1_char4; + _gfortran_eoshift0_2_char4; + _gfortran_eoshift0_4_char4; + _gfortran_eoshift0_8_char4; + _gfortran_eoshift1_16_char4; + _gfortran_eoshift1_4_char4; + _gfortran_eoshift1_8_char4; + _gfortran_eoshift2_16; + _gfortran_eoshift2_16_char; + _gfortran_eoshift2_1_char4; + _gfortran_eoshift2_2_char4; + _gfortran_eoshift2_4_char4; + _gfortran_eoshift2_8_char4; + _gfortran_eoshift3_16_char4; + _gfortran_eoshift3_4_char4; + _gfortran_eoshift3_8_char4; + _gfortran_erfc_scaled_r10; + _gfortran_erfc_scaled_r16; + _gfortran_erfc_scaled_r4; + _gfortran_erfc_scaled_r8; + _gfortran_pack_char4; + _gfortran_pack_s_char4; + _gfortran_reshape_char4; + _gfortran_runtime_warning_at; + _gfortran_selected_char_kind; + _gfortran_select_string_char4; + _gfortran_spread_char4; + _gfortran_spread_char4_scalar; + _gfortran_string_index_char4; + _gfortran_string_len_trim_char4; + _gfortran_string_minmax_char4; + _gfortran_string_scan_char4; + _gfortran_string_trim_char4; + _gfortran_string_verify_char4; + _gfortran_st_wait; + _gfortran_transfer_character_wide; + _gfortran_transpose_char4; + _gfortran_unpack0_char4; + _gfortran_unpack1_char4; + } GFORTRAN_1.0; + F2C_1.0 { global: _gfortran_f2c_specific__abs_c4; diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/abort.c gcc-4.4.0/libgfortran/intrinsics/abort.c *** gcc-4.3.3/libgfortran/intrinsics/abort.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/abort.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** /* Implementation of the ABORT intrinsic. ! Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 1,26 ---- /* Implementation of the ABORT intrinsic. ! Copyright (C) 2003, 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/access.c gcc-4.4.0/libgfortran/intrinsics/access.c *** gcc-4.3.3/libgfortran/intrinsics/access.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/access.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the ACCESS intrinsic. ! Copyright (C) 2006, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the ACCESS intrinsic. ! Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/args.c gcc-4.4.0/libgfortran/intrinsics/args.c *** gcc-4.3.3/libgfortran/intrinsics/args.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/args.c Thu Apr 9 23:23:07 2009 *************** *** 1,6 **** /* Implementation of the GETARG and IARGC g77, and corresponding F2003, intrinsics. ! Copyright (C) 2004, 2005, 2007 Free Software Foundation, Inc. Contributed by Bud Davis and Janne Blomqvist. This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,6 ---- /* Implementation of the GETARG and IARGC g77, and corresponding F2003, intrinsics. ! Copyright (C) 2004, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Bud Davis and Janne Blomqvist. This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 8,33 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 8,28 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/associated.c gcc-4.4.0/libgfortran/intrinsics/associated.c *** gcc-4.3.3/libgfortran/intrinsics/associated.c Fri Aug 10 13:20:46 2007 --- gcc-4.4.0/libgfortran/intrinsics/associated.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the ASSOCIATED intrinsic ! Copyright 2003 Free Software Foundation, Inc. Contributed by kejia Zhao (CCRG) This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the ASSOCIATED intrinsic ! Copyright 2003, 2009 Free Software Foundation, Inc. Contributed by kejia Zhao (CCRG) This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" *************** associated (const gfc_array_void *pointe *** 48,57 **** rank = GFC_DESCRIPTOR_RANK (pointer); for (n = 0; n < rank; n++) { ! if (pointer->dim[n].stride != target->dim[n].stride) return 0; ! if ((pointer->dim[n].ubound - pointer->dim[n].lbound) ! != (target->dim[n].ubound - target->dim[n].lbound)) return 0; if (pointer->dim[n].ubound < pointer->dim[n].lbound) return 0; --- 43,54 ---- rank = GFC_DESCRIPTOR_RANK (pointer); for (n = 0; n < rank; n++) { ! long diff; ! diff = pointer->dim[n].ubound - pointer->dim[n].lbound; ! ! if (diff != (target->dim[n].ubound - target->dim[n].lbound)) return 0; ! if (pointer->dim[n].stride != target->dim[n].stride && diff != 0) return 0; if (pointer->dim[n].ubound < pointer->dim[n].lbound) return 0; diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/c99_functions.c gcc-4.4.0/libgfortran/intrinsics/c99_functions.c *** gcc-4.3.3/libgfortran/intrinsics/c99_functions.c Wed Dec 31 15:42:12 2008 --- gcc-4.4.0/libgfortran/intrinsics/c99_functions.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** /* Implementation of various C99 functions ! Copyright (C) 2004 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" --- 1,26 ---- /* Implementation of various C99 functions ! Copyright (C) 2004, 2009 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "config.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/chdir.c gcc-4.4.0/libgfortran/intrinsics/chdir.c *** gcc-4.3.3/libgfortran/intrinsics/chdir.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/chdir.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the CHDIR intrinsic. ! Copyright (C) 2005, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the CHDIR intrinsic. ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/chmod.c gcc-4.4.0/libgfortran/intrinsics/chmod.c *** gcc-4.3.3/libgfortran/intrinsics/chmod.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/chmod.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the CHMOD intrinsic. ! Copyright (C) 2006, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the CHMOD intrinsic. ! Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/clock.c gcc-4.4.0/libgfortran/intrinsics/clock.c *** gcc-4.3.3/libgfortran/intrinsics/clock.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/clock.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MCLOCK and MCLOCK8 g77 intrinsics. ! Copyright (C) 2006, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MCLOCK and MCLOCK8 g77 intrinsics. ! Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/cpu_time.c gcc-4.4.0/libgfortran/intrinsics/cpu_time.c *** gcc-4.3.3/libgfortran/intrinsics/cpu_time.c Tue Dec 25 10:41:44 2007 --- gcc-4.4.0/libgfortran/intrinsics/cpu_time.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** /* Implementation of the CPU_TIME intrinsic. ! Copyright (C) 2003, 2007 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include "time_1.h" --- 1,26 ---- /* Implementation of the CPU_TIME intrinsic. ! Copyright (C) 2003, 2007, 2009 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include "time_1.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/cshift0.c gcc-4.4.0/libgfortran/intrinsics/cshift0.c *** gcc-4.3.3/libgfortran/intrinsics/cshift0.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/cshift0.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Generic implementation of the CSHIFT intrinsic ! Copyright 2003, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Feng Wang This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Generic implementation of the CSHIFT intrinsic ! Copyright 2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Feng Wang This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,80 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include #include #include - - /* "Templatized" helper function for the inner shift loop. */ - - #define DEF_COPY_LOOP(NAME, TYPE) \ - static inline void \ - copy_loop_##NAME (void *xdest, const void *xsrc, \ - size_t roff, size_t soff, \ - index_type len, index_type shift) \ - { \ - TYPE *dest = xdest; \ - const TYPE *src; \ - index_type i; \ - \ - roff /= sizeof (TYPE); \ - soff /= sizeof (TYPE); \ - \ - src = xsrc; \ - src += shift * soff; \ - for (i = 0; i < len - shift; ++i) \ - { \ - *dest = *src; \ - dest += roff; \ - src += soff; \ - } \ - \ - src = xsrc; \ - for (i = 0; i < shift; ++i) \ - { \ - *dest = *src; \ - dest += roff; \ - src += soff; \ - } \ - } - - DEF_COPY_LOOP(int, int) - DEF_COPY_LOOP(long, long) - DEF_COPY_LOOP(double, double) - DEF_COPY_LOOP(ldouble, long double) - DEF_COPY_LOOP(cfloat, _Complex float) - DEF_COPY_LOOP(cdouble, _Complex double) - - static void cshift0 (gfc_array_char * ret, const gfc_array_char * array, ssize_t shift, int which, index_type size) --- 7,33 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include #include #include static void cshift0 (gfc_array_char * ret, const gfc_array_char * array, ssize_t shift, int which, index_type size) *************** cshift0 (gfc_array_char * ret, const gfc *** 96,151 **** index_type dim; index_type len; index_type n; ! int whichloop; if (which < 1 || which > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); ! which = which - 1; ! sstride[0] = 0; ! rstride[0] = 0; ! ! extent[0] = 1; ! count[0] = 0; ! n = 0; ! ! /* The values assigned here must match the cases in the inner loop. */ ! whichloop = 0; ! switch (GFC_DESCRIPTOR_TYPE (array)) ! { ! case GFC_DTYPE_LOGICAL: ! case GFC_DTYPE_INTEGER: ! case GFC_DTYPE_REAL: ! if (size == sizeof (int)) ! whichloop = 1; ! else if (size == sizeof (long)) ! whichloop = 2; ! else if (size == sizeof (double)) ! whichloop = 3; ! else if (size == sizeof (long double)) ! whichloop = 4; ! break; ! ! case GFC_DTYPE_COMPLEX: ! if (size == sizeof (_Complex float)) ! whichloop = 5; ! else if (size == sizeof (_Complex double)) ! whichloop = 6; ! break; ! ! default: ! break; ! } ! ! /* Initialized for avoiding compiler warnings. */ ! roffset = size; ! soffset = size; ! len = 0; if (ret->data == NULL) { int i; - index_type arraysize = size0 ((array_t *)array); ret->offset = 0; ret->dtype = array->dtype; --- 49,66 ---- index_type dim; index_type len; index_type n; ! index_type arraysize; ! ! index_type type_size; if (which < 1 || which > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); ! arraysize = size0 ((array_t *) array); if (ret->data == NULL) { int i; ret->offset = 0; ret->dtype = array->dtype; *************** cshift0 (gfc_array_char * ret, const gfc *** 169,174 **** --- 84,278 ---- return; } } + + if (arraysize == 0) + return; + type_size = GFC_DTYPE_TYPE_SIZE (array); + + switch(type_size) + { + case GFC_DTYPE_LOGICAL_1: + case GFC_DTYPE_INTEGER_1: + case GFC_DTYPE_DERIVED_1: + cshift0_i1 ((gfc_array_i1 *)ret, (gfc_array_i1 *) array, shift, which); + return; + + case GFC_DTYPE_LOGICAL_2: + case GFC_DTYPE_INTEGER_2: + cshift0_i2 ((gfc_array_i2 *)ret, (gfc_array_i2 *) array, shift, which); + return; + + case GFC_DTYPE_LOGICAL_4: + case GFC_DTYPE_INTEGER_4: + cshift0_i4 ((gfc_array_i4 *)ret, (gfc_array_i4 *) array, shift, which); + return; + + case GFC_DTYPE_LOGICAL_8: + case GFC_DTYPE_INTEGER_8: + cshift0_i8 ((gfc_array_i8 *)ret, (gfc_array_i8 *) array, shift, which); + return; + + #ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_LOGICAL_16: + case GFC_DTYPE_INTEGER_16: + cshift0_i16 ((gfc_array_i16 *)ret, (gfc_array_i16 *) array, shift, + which); + return; + #endif + + case GFC_DTYPE_REAL_4: + cshift0_r4 ((gfc_array_r4 *)ret, (gfc_array_r4 *) array, shift, which); + return; + + case GFC_DTYPE_REAL_8: + cshift0_r8 ((gfc_array_r8 *)ret, (gfc_array_r8 *) array, shift, which); + return; + + #ifdef HAVE_GFC_REAL_10 + case GFC_DTYPE_REAL_10: + cshift0_r10 ((gfc_array_r10 *)ret, (gfc_array_r10 *) array, shift, + which); + return; + #endif + + #ifdef HAVE_GFC_REAL_16 + case GFC_DTYPE_REAL_16: + cshift0_r16 ((gfc_array_r16 *)ret, (gfc_array_r16 *) array, shift, + which); + return; + #endif + + case GFC_DTYPE_COMPLEX_4: + cshift0_c4 ((gfc_array_c4 *)ret, (gfc_array_c4 *) array, shift, which); + return; + + case GFC_DTYPE_COMPLEX_8: + cshift0_c8 ((gfc_array_c8 *)ret, (gfc_array_c8 *) array, shift, which); + return; + + #ifdef HAVE_GFC_COMPLEX_10 + case GFC_DTYPE_COMPLEX_10: + cshift0_c10 ((gfc_array_c10 *)ret, (gfc_array_c10 *) array, shift, + which); + return; + #endif + + #ifdef HAVE_GFC_COMPLEX_16 + case GFC_DTYPE_COMPLEX_16: + cshift0_c16 ((gfc_array_c16 *)ret, (gfc_array_c16 *) array, shift, + which); + return; + #endif + + default: + break; + } + + switch (size) + { + /* Let's check the actual alignment of the data pointers. If they + are suitably aligned, we can safely call the unpack functions. */ + + case sizeof (GFC_INTEGER_1): + cshift0_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) array, shift, + which); + break; + + case sizeof (GFC_INTEGER_2): + if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(array->data)) + break; + else + { + cshift0_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) array, shift, + which); + return; + } + + case sizeof (GFC_INTEGER_4): + if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(array->data)) + break; + else + { + cshift0_i4 ((gfc_array_i4 *)ret, (gfc_array_i4 *) array, shift, + which); + return; + } + + case sizeof (GFC_INTEGER_8): + if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(array->data)) + { + /* Let's try to use the complex routines. First, a sanity + check that the sizes match; this should be optimized to + a no-op. */ + if (sizeof(GFC_INTEGER_8) != sizeof(GFC_COMPLEX_4)) + break; + + if (GFC_UNALIGNED_C4(ret->data) || GFC_UNALIGNED_C4(array->data)) + break; + + cshift0_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) array, shift, + which); + return; + } + else + { + cshift0_i8 ((gfc_array_i8 *)ret, (gfc_array_i8 *) array, shift, + which); + return; + } + + #ifdef HAVE_GFC_INTEGER_16 + case sizeof (GFC_INTEGER_16): + if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(array->data)) + { + /* Let's try to use the complex routines. First, a sanity + check that the sizes match; this should be optimized to + a no-op. */ + if (sizeof(GFC_INTEGER_16) != sizeof(GFC_COMPLEX_8)) + break; + + if (GFC_UNALIGNED_C8(ret->data) || GFC_UNALIGNED_C8(array->data)) + break; + + cshift0_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) array, shift, + which); + return; + } + else + { + cshift0_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) array, + shift, which); + return; + } + #else + case sizeof (GFC_COMPLEX_8): + + if (GFC_UNALIGNED_C8(ret->data) || GFC_UNALIGNED_C8(array->data)) + break; + else + { + cshift0_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) array, shift, + which); + return; + } + #endif + + default: + break; + } + + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = size; + soffset = size; + len = 0; for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) { *************** cshift0 (gfc_array_char * ret, const gfc *** 202,208 **** rptr = ret->data; sptr = array->data; ! shift = shift % (ssize_t)len; if (shift < 0) shift += len; --- 306,312 ---- rptr = ret->data; sptr = array->data; ! shift = len == 0 ? 0 : shift % (ssize_t)len; if (shift < 0) shift += len; *************** cshift0 (gfc_array_char * ret, const gfc *** 222,277 **** else { /* Otherwise, we'll have to perform the copy one element at ! a time. We can speed this up a tad for common cases of ! fundamental types. */ ! switch (whichloop) ! { ! case 0: ! { ! char *dest = rptr; ! const char *src = &sptr[shift * soffset]; ! ! for (n = 0; n < len - shift; n++) ! { ! memcpy (dest, src, size); ! dest += roffset; ! src += soffset; ! } ! for (src = sptr, n = 0; n < shift; n++) ! { ! memcpy (dest, src, size); ! dest += roffset; ! src += soffset; ! } ! } ! break; ! ! case 1: ! copy_loop_int (rptr, sptr, roffset, soffset, len, shift); ! break; ! ! case 2: ! copy_loop_long (rptr, sptr, roffset, soffset, len, shift); ! break; ! ! case 3: ! copy_loop_double (rptr, sptr, roffset, soffset, len, shift); ! break; ! ! case 4: ! copy_loop_ldouble (rptr, sptr, roffset, soffset, len, shift); ! break; ! ! case 5: ! copy_loop_cfloat (rptr, sptr, roffset, soffset, len, shift); ! break; ! ! case 6: ! copy_loop_cdouble (rptr, sptr, roffset, soffset, len, shift); ! break; ! default: ! abort (); } } --- 326,346 ---- else { /* Otherwise, we'll have to perform the copy one element at ! a time. */ ! char *dest = rptr; ! const char *src = &sptr[shift * soffset]; ! for (n = 0; n < len - shift; n++) ! { ! memcpy (dest, src, size); ! dest += roffset; ! src += soffset; ! } ! for (src = sptr, n = 0; n < shift; n++) ! { ! memcpy (dest, src, size); ! dest += roffset; ! src += soffset; } } *************** cshift0 (gfc_array_char * ret, const gfc *** 334,342 **** --- 403,432 ---- GFC_INTEGER_4 array_length) \ { \ cshift0 (ret, array, *pshift, pdim ? *pdim : 1, array_length); \ + } \ + \ + extern void cshift0_##N##_char4 (gfc_array_char *, GFC_INTEGER_4, \ + const gfc_array_char *, \ + const GFC_INTEGER_##N *, \ + const GFC_INTEGER_##N *, GFC_INTEGER_4); \ + export_proto(cshift0_##N##_char4); \ + \ + void \ + cshift0_##N##_char4 (gfc_array_char *ret, \ + GFC_INTEGER_4 ret_length __attribute__((unused)), \ + const gfc_array_char *array, \ + const GFC_INTEGER_##N *pshift, \ + const GFC_INTEGER_##N *pdim, \ + GFC_INTEGER_4 array_length) \ + { \ + cshift0 (ret, array, *pshift, pdim ? *pdim : 1, \ + array_length * sizeof (gfc_char4_t)); \ } DEFINE_CSHIFT (1); DEFINE_CSHIFT (2); DEFINE_CSHIFT (4); DEFINE_CSHIFT (8); + #ifdef HAVE_GFC_INTEGER_16 + DEFINE_CSHIFT (16); + #endif diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/ctime.c gcc-4.4.0/libgfortran/intrinsics/ctime.c *** gcc-4.3.3/libgfortran/intrinsics/ctime.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/ctime.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the CTIME and FDATE g77 intrinsics. ! Copyright (C) 2005, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the CTIME and FDATE g77 intrinsics. ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/date_and_time.c gcc-4.4.0/libgfortran/intrinsics/date_and_time.c *** gcc-4.3.3/libgfortran/intrinsics/date_and_time.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/date_and_time.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the DATE_AND_TIME intrinsic. ! Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Steven Bosscher. This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,6 ---- /* Implementation of the DATE_AND_TIME intrinsic. ! Copyright (C) 2003, 2004, 2005, 2006, 2007, 2009 ! Free Software Foundation, Inc. Contributed by Steven Bosscher. This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 8,28 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/dprod_r8.f90 gcc-4.4.0/libgfortran/intrinsics/dprod_r8.f90 *** gcc-4.3.3/libgfortran/intrinsics/dprod_r8.f90 Sat Jan 20 18:33:20 2007 --- gcc-4.4.0/libgfortran/intrinsics/dprod_r8.f90 Thu Apr 9 23:23:07 2009 *************** *** 1,25 **** ! ! Copyright 2003 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). ! ! !GNU libgfor is free software; you can redistribute it and/or ! !modify it under the terms of the GNU Lesser General Public !License as published by the Free Software Foundation; either ! !version 2.1 of the License, or (at your option) any later version. ! ! !GNU libgfor is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! !GNU Lesser General Public License for more details. ! ! !You should have received a copy of the GNU Lesser General Public ! !License along with libgfor; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. elemental function _gfortran_specific__dprod_r8 (p1, p2) real (kind=4), intent (in) :: p1, p2 real (kind=8) :: _gfortran_specific__dprod_r8 --- 1,30 ---- ! ! Copyright 2003, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). ! ! !Libgfortran is free software; you can redistribute it and/or ! !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! ! !Libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. elemental function _gfortran_specific__dprod_r8 (p1, p2) + implicit none real (kind=4), intent (in) :: p1, p2 real (kind=8) :: _gfortran_specific__dprod_r8 diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/dtime.c gcc-4.4.0/libgfortran/intrinsics/dtime.c *** gcc-4.3.3/libgfortran/intrinsics/dtime.c Tue Dec 25 10:41:44 2007 --- gcc-4.4.0/libgfortran/intrinsics/dtime.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** /* Implementation of the dtime intrinsic. ! Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include "time_1.h" --- 1,26 ---- /* Implementation of the dtime intrinsic. ! Copyright (C) 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include "time_1.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/env.c gcc-4.4.0/libgfortran/intrinsics/env.c *** gcc-4.3.3/libgfortran/intrinsics/env.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/env.c Thu Apr 9 23:23:07 2009 *************** *** 1,6 **** /* Implementation of the GETENV g77, and GET_ENVIRONMENT_VARIABLE F2003, intrinsics. ! Copyright (C) 2004, 2007 Free Software Foundation, Inc. Contributed by Janne Blomqvist. This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,6 ---- /* Implementation of the GETENV g77, and GET_ENVIRONMENT_VARIABLE F2003, intrinsics. ! Copyright (C) 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Janne Blomqvist. This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 8,33 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 8,28 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/eoshift0.c gcc-4.4.0/libgfortran/intrinsics/eoshift0.c *** gcc-4.3.3/libgfortran/intrinsics/eoshift0.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/eoshift0.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Generic implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Generic implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** Boston, MA 02110-1301, USA. */ *** 39,51 **** static void eoshift0 (gfc_array_char * ret, const gfc_array_char * array, int shift, const char * pbound, int which, index_type size, ! char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; ! char *rptr; char *dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; --- 34,46 ---- static void eoshift0 (gfc_array_char * ret, const gfc_array_char * array, int shift, const char * pbound, int which, index_type size, ! const char *filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; ! char * restrict rptr; char *dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; *************** eoshift0 (gfc_array_char * ret, const gf *** 84,89 **** --- 79,89 ---- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; } } + else + { + if (size0 ((array_t *) ret) == 0) + return; + } which = which - 1; *************** eoshift0 (gfc_array_char * ret, const gf *** 175,181 **** else while (n--) { ! memset (dest, filler, size); dest += roffset; } --- 175,188 ---- else while (n--) { ! index_type i; ! ! if (filler_len == 1) ! memset (dest, filler[0], size); ! else ! for (i = 0; i < size ; i += filler_len) ! memcpy (&dest[i], filler, filler_len); ! dest += roffset; } *************** eoshift0 (gfc_array_char * ret, const gf *** 223,229 **** const GFC_INTEGER_##N *pdim) \ { \ eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ ! GFC_DESCRIPTOR_SIZE (array), 0); \ } \ \ extern void eoshift0_##N##_char (gfc_array_char *, GFC_INTEGER_4, \ --- 230,236 ---- const GFC_INTEGER_##N *pdim) \ { \ eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ ! GFC_DESCRIPTOR_SIZE (array), "\0", 1); \ } \ \ extern void eoshift0_##N##_char (gfc_array_char *, GFC_INTEGER_4, \ *************** eoshift0 (gfc_array_char * ret, const gf *** 244,253 **** GFC_INTEGER_4 bound_length __attribute__((unused))) \ { \ eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ ! array_length, ' '); \ } DEFINE_EOSHIFT (1); DEFINE_EOSHIFT (2); DEFINE_EOSHIFT (4); DEFINE_EOSHIFT (8); --- 251,286 ---- GFC_INTEGER_4 bound_length __attribute__((unused))) \ { \ eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ ! array_length, " ", 1); \ ! } \ ! \ ! extern void eoshift0_##N##_char4 (gfc_array_char *, GFC_INTEGER_4, \ ! const gfc_array_char *, \ ! const GFC_INTEGER_##N *, const char *, \ ! const GFC_INTEGER_##N *, GFC_INTEGER_4, \ ! GFC_INTEGER_4); \ ! export_proto(eoshift0_##N##_char4); \ ! \ ! void \ ! eoshift0_##N##_char4 (gfc_array_char *ret, \ ! GFC_INTEGER_4 ret_length __attribute__((unused)), \ ! const gfc_array_char *array, \ ! const GFC_INTEGER_##N *pshift, \ ! const char *pbound, \ ! const GFC_INTEGER_##N *pdim, \ ! GFC_INTEGER_4 array_length, \ ! GFC_INTEGER_4 bound_length __attribute__((unused))) \ ! { \ ! static const gfc_char4_t space = (unsigned char) ' '; \ ! eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ ! array_length * sizeof (gfc_char4_t), (const char *) &space, \ ! sizeof (gfc_char4_t)); \ } DEFINE_EOSHIFT (1); DEFINE_EOSHIFT (2); DEFINE_EOSHIFT (4); DEFINE_EOSHIFT (8); + #ifdef HAVE_GFC_INTEGER_16 + DEFINE_EOSHIFT (16); + #endif diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/eoshift2.c gcc-4.4.0/libgfortran/intrinsics/eoshift2.c *** gcc-4.3.3/libgfortran/intrinsics/eoshift2.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/eoshift2.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Generic implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Generic implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** Boston, MA 02110-1301, USA. */ *** 39,51 **** static void eoshift2 (gfc_array_char *ret, const gfc_array_char *array, int shift, const gfc_array_char *bound, int which, ! index_type size, char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; ! char *rptr; char *dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; --- 34,46 ---- static void eoshift2 (gfc_array_char *ret, const gfc_array_char *array, int shift, const gfc_array_char *bound, int which, ! index_type size, const char *filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; ! char * restrict rptr; char *dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; *************** eoshift2 (gfc_array_char *ret, const gfc *** 63,68 **** --- 58,64 ---- index_type dim; index_type len; index_type n; + index_type arraysize; /* The compiler cannot figure out that these are set, initialize them to avoid warnings. */ *************** eoshift2 (gfc_array_char *ret, const gfc *** 70,80 **** soffset = 0; roffset = 0; if (ret->data == NULL) { int i; ! ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) --- 66,78 ---- soffset = 0; roffset = 0; + arraysize = size0 ((array_t *) array); + if (ret->data == NULL) { int i; ! ret->data = internal_malloc_size (size * arraysize); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) *************** eoshift2 (gfc_array_char *ret, const gfc *** 88,93 **** --- 86,99 ---- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; } } + else + { + if (size0 ((array_t *) ret) == 0) + return; + } + + if (arraysize == 0 && filler == NULL) + return; which = which - 1; *************** eoshift2 (gfc_array_char *ret, const gfc *** 192,198 **** else while (n--) { ! memset (dest, filler, size); dest += roffset; } --- 198,211 ---- else while (n--) { ! index_type i; ! ! if (filler_len == 1) ! memset (dest, filler[0], size); ! else ! for (i = 0; i < size ; i += filler_len) ! memcpy (&dest[i], filler, filler_len); ! dest += roffset; } *************** eoshift2 (gfc_array_char *ret, const gfc *** 243,249 **** const GFC_INTEGER_##N *pdim) \ { \ eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ ! GFC_DESCRIPTOR_SIZE (array), 0); \ } \ \ extern void eoshift2_##N##_char (gfc_array_char *, GFC_INTEGER_4, \ --- 256,262 ---- const GFC_INTEGER_##N *pdim) \ { \ eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ ! GFC_DESCRIPTOR_SIZE (array), "\0", 1); \ } \ \ extern void eoshift2_##N##_char (gfc_array_char *, GFC_INTEGER_4, \ *************** eoshift2 (gfc_array_char *ret, const gfc *** 265,274 **** GFC_INTEGER_4 bound_length __attribute__((unused))) \ { \ eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ ! array_length, ' '); \ } DEFINE_EOSHIFT (1); DEFINE_EOSHIFT (2); DEFINE_EOSHIFT (4); DEFINE_EOSHIFT (8); --- 278,314 ---- GFC_INTEGER_4 bound_length __attribute__((unused))) \ { \ eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ ! array_length, " ", 1); \ ! } \ ! \ ! extern void eoshift2_##N##_char4 (gfc_array_char *, GFC_INTEGER_4, \ ! const gfc_array_char *, \ ! const GFC_INTEGER_##N *, \ ! const gfc_array_char *, \ ! const GFC_INTEGER_##N *, \ ! GFC_INTEGER_4, GFC_INTEGER_4); \ ! export_proto(eoshift2_##N##_char4); \ ! \ ! void \ ! eoshift2_##N##_char4 (gfc_array_char *ret, \ ! GFC_INTEGER_4 ret_length __attribute__((unused)), \ ! const gfc_array_char *array, \ ! const GFC_INTEGER_##N *pshift, \ ! const gfc_array_char *pbound, \ ! const GFC_INTEGER_##N *pdim, \ ! GFC_INTEGER_4 array_length, \ ! GFC_INTEGER_4 bound_length __attribute__((unused))) \ ! { \ ! static const gfc_char4_t space = (unsigned char) ' '; \ ! eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ ! array_length * sizeof (gfc_char4_t), (const char *) &space, \ ! sizeof (gfc_char4_t)); \ } DEFINE_EOSHIFT (1); DEFINE_EOSHIFT (2); DEFINE_EOSHIFT (4); DEFINE_EOSHIFT (8); + #ifdef HAVE_GFC_INTEGER_16 + DEFINE_EOSHIFT (16); + #endif diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/erfc_scaled.c gcc-4.4.0/libgfortran/intrinsics/erfc_scaled.c *** gcc-4.3.3/libgfortran/intrinsics/erfc_scaled.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/intrinsics/erfc_scaled.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,52 ---- + /* Implementation of the ERFC_SCALED intrinsic. + Copyright (C) 2008, 2009 Free Software Foundation, Inc. + + This file is part of the GNU Fortran runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + + /* This implementation of ERFC_SCALED is based on the netlib algorithm + available at http://www.netlib.org/specfun/erf */ + + #ifdef HAVE_GFC_REAL_4 + #undef KIND + #define KIND 4 + #include "erfc_scaled_inc.c" + #endif + + #ifdef HAVE_GFC_REAL_8 + #undef KIND + #define KIND 8 + #include "erfc_scaled_inc.c" + #endif + + #ifdef HAVE_GFC_REAL_10 + #undef KIND + #define KIND 10 + #include "erfc_scaled_inc.c" + #endif + + #ifdef HAVE_GFC_REAL_16 + #undef KIND + #define KIND 16 + #include "erfc_scaled_inc.c" + #endif diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/erfc_scaled_inc.c gcc-4.4.0/libgfortran/intrinsics/erfc_scaled_inc.c *** gcc-4.3.3/libgfortran/intrinsics/erfc_scaled_inc.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/intrinsics/erfc_scaled_inc.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,184 ---- + /* Implementation of the ERFC_SCALED intrinsic, to be included by erfc_scaled.c + Copyright (c) 2008 Free Software Foundation, Inc. + + This file is part of the GNU Fortran runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR a PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + /* This implementation of ERFC_SCALED is based on the netlib algorithm + available at http://www.netlib.org/specfun/erf */ + + #define TYPE KIND_SUFFIX(GFC_REAL_,KIND) + #define CONCAT(x,y) x ## y + #define KIND_SUFFIX(x,y) CONCAT(x,y) + + #if (KIND == 4) + + # define EXP(x) expf(x) + # define TRUNC(x) truncf(x) + + #elif (KIND == 8) + + # define EXP(x) exp(x) + # define TRUNC(x) trunc(x) + + #else + + # ifdef HAVE_EXPL + # define EXP(x) expl(x) + # endif + # ifdef HAVE_TRUNCL + # define TRUNC(x) truncl(x) + # endif + + #endif + + #if defined(EXP) && defined(TRUNC) + + extern TYPE KIND_SUFFIX(erfc_scaled_r,KIND) (TYPE); + export_proto(KIND_SUFFIX(erfc_scaled_r,KIND)); + + TYPE + KIND_SUFFIX(erfc_scaled_r,KIND) (TYPE x) + { + /* The main computation evaluates near-minimax approximations + from "Rational Chebyshev approximations for the error function" + by W. J. Cody, Math. Comp., 1969, PP. 631-638. This + transportable program uses rational functions that theoretically + approximate erf(x) and erfc(x) to at least 18 significant + decimal digits. The accuracy achieved depends on the arithmetic + system, the compiler, the intrinsic functions, and proper + selection of the machine-dependent constants. */ + + int i; + TYPE del, res, xden, xnum, y, ysq; + + #if (KIND == 4) + static TYPE xneg = -9.382, xsmall = 5.96e-8, + xbig = 9.194, xhuge = 2.90e+3, xmax = 4.79e+37; + #else + static TYPE xneg = -26.628, xsmall = 1.11e-16, + xbig = 26.543, xhuge = 6.71e+7, xmax = 2.53e+307; + #endif + + #define SQRPI ((TYPE) 0.56418958354775628695L) + #define THRESH ((TYPE) 0.46875L) + + static TYPE a[5] = { 3.16112374387056560l, 113.864154151050156l, + 377.485237685302021l, 3209.37758913846947l, 0.185777706184603153l }; + + static TYPE b[4] = { 23.6012909523441209l, 244.024637934444173l, + 1282.61652607737228l, 2844.23683343917062l }; + + static TYPE c[9] = { 0.564188496988670089l, 8.88314979438837594l, + 66.1191906371416295l, 298.635138197400131l, 881.952221241769090l, + 1712.04761263407058l, 2051.07837782607147l, 1230.33935479799725l, + 2.15311535474403846e-8l }; + + static TYPE d[8] = { 15.7449261107098347l, 117.693950891312499l, + 537.181101862009858l, 1621.38957456669019l, 3290.79923573345963l, + 4362.61909014324716l, 3439.36767414372164l, 1230.33935480374942l }; + + static TYPE p[6] = { 0.305326634961232344l, 0.360344899949804439l, + 0.125781726111229246l, 0.0160837851487422766l, + 0.000658749161529837803l, 0.0163153871373020978l }; + + static TYPE q[5] = { 2.56852019228982242l, 1.87295284992346047l, + 0.527905102951428412l, 0.0605183413124413191l, + 0.00233520497626869185l }; + + y = (x > 0 ? x : -x); + if (y <= THRESH) + { + ysq = 0; + if (y > xsmall) + ysq = y * y; + xnum = a[4]*ysq; + xden = ysq; + for (i = 0; i <= 2; i++) + { + xnum = (xnum + a[i]) * ysq; + xden = (xden + b[i]) * ysq; + } + res = x * (xnum + a[3]) / (xden + b[3]); + res = 1 - res; + res = EXP(ysq) * res; + return res; + } + else if (y <= 4) + { + xnum = c[8]*y; + xden = y; + for (i = 0; i <= 6; i++) + { + xnum = (xnum + c[i]) * y; + xden = (xden + d[i]) * y; + } + res = (xnum + c[7]) / (xden + d[7]); + } + else + { + res = 0; + if (y >= xbig) + { + if (y >= xmax) + goto finish; + if (y >= xhuge) + { + res = SQRPI / y; + goto finish; + } + } + ysq = ((TYPE) 1) / (y * y); + xnum = p[5]*ysq; + xden = ysq; + for (i = 0; i <= 3; i++) + { + xnum = (xnum + p[i]) * ysq; + xden = (xden + q[i]) * ysq; + } + res = ysq *(xnum + p[4]) / (xden + q[4]); + res = (SQRPI - res) / y; + } + + finish: + if (x < 0) + { + if (x < xneg) + res = __builtin_inf (); + else + { + ysq = TRUNC (x*((TYPE) 16))/((TYPE) 16); + del = (x-ysq)*(x+ysq); + y = EXP(ysq*ysq) * EXP(del); + res = (y+y) - res; + } + } + return res; + } + + #endif + + #undef EXP + #undef TRUNC + + #undef CONCAT + #undef TYPE + #undef KIND_SUFFIX diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/etime.c gcc-4.4.0/libgfortran/intrinsics/etime.c *** gcc-4.3.3/libgfortran/intrinsics/etime.c Tue Dec 25 10:41:44 2007 --- gcc-4.4.0/libgfortran/intrinsics/etime.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the ETIME intrinsic. ! Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the ETIME intrinsic. ! Copyright (C) 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include "time_1.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include "time_1.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/exit.c gcc-4.4.0/libgfortran/intrinsics/exit.c *** gcc-4.3.3/libgfortran/intrinsics/exit.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/exit.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the EXIT intrinsic. ! Copyright (C) 2004, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the EXIT intrinsic. ! Copyright (C) 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/f2c_specifics.F90 gcc-4.4.0/libgfortran/intrinsics/f2c_specifics.F90 *** gcc-4.3.3/libgfortran/intrinsics/f2c_specifics.F90 Sat Jan 20 18:33:20 2007 --- gcc-4.4.0/libgfortran/intrinsics/f2c_specifics.F90 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! ! Copyright 2002, 2005 Free Software Foundation, Inc. ! Contributed by Tobias Schl"uter ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! ! Copyright 2002, 2005, 2009 Free Software Foundation, Inc. ! Contributed by Tobias Schl"uter ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,32 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. ! ! !In addition to the permissions in the GNU General Public License, the ! !Free Software Foundation gives you unlimited permission to link the ! !compiled version of this file into combinations with other programs, ! !and to distribute those combinations without any restriction coming ! !from the use of this file. (The General Public License restrictions ! !do apply in other respects; for example, they cover modification of ! !the file, and distribution when not linked into a combine ! !executable.) ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! ! Specifics for the intrinsics whose calling conventions change if ! -ff2c is used. ! --- 6,27 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! + !You should have received a copy of the GNU General Public License and + !a copy of the GCC Runtime Library Exception along with this program; + !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + !. + ! Specifics for the intrinsics whose calling conventions change if ! -ff2c is used. ! diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/fnum.c gcc-4.4.0/libgfortran/intrinsics/fnum.c *** gcc-4.3.3/libgfortran/intrinsics/fnum.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/fnum.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the FNUM intrinsics. ! Copyright (C) 2004, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the FNUM intrinsics. ! Copyright (C) 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/gerror.c gcc-4.4.0/libgfortran/intrinsics/gerror.c *** gcc-4.3.3/libgfortran/intrinsics/gerror.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/gerror.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the GERROR g77 intrinsic. ! Copyright (C) 2005, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the GERROR g77 intrinsic. ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/getXid.c gcc-4.4.0/libgfortran/intrinsics/getXid.c *** gcc-4.3.3/libgfortran/intrinsics/getXid.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/getXid.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** /* Wrapper for the unix get{g,p,u}id functions. ! Copyright (C) 2004, 2007 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 1,26 ---- /* Wrapper for the unix get{g,p,u}id functions. ! Copyright (C) 2004, 2007, 2009 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/getcwd.c gcc-4.4.0/libgfortran/intrinsics/getcwd.c *** gcc-4.3.3/libgfortran/intrinsics/getcwd.c Sat Sep 15 14:52:46 2007 --- gcc-4.4.0/libgfortran/intrinsics/getcwd.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the GETCWD intrinsic. ! Copyright (C) 2004, 2005, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the GETCWD intrinsic. ! Copyright (C) 2004, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/getlog.c gcc-4.4.0/libgfortran/intrinsics/getlog.c *** gcc-4.3.3/libgfortran/intrinsics/getlog.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/getlog.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the GETLOG g77 intrinsic. ! Copyright (C) 2005, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the GETLOG g77 intrinsic. ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/hostnm.c gcc-4.4.0/libgfortran/intrinsics/hostnm.c *** gcc-4.3.3/libgfortran/intrinsics/hostnm.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/hostnm.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the HOSTNM intrinsic. ! Copyright (C) 2005, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the HOSTNM intrinsic. ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/ierrno.c gcc-4.4.0/libgfortran/intrinsics/ierrno.c *** gcc-4.3.3/libgfortran/intrinsics/ierrno.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/ierrno.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the IERRNO intrinsic. ! Copyright (C) 2005, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the IERRNO intrinsic. ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/ishftc.c gcc-4.4.0/libgfortran/intrinsics/ishftc.c *** gcc-4.3.3/libgfortran/intrinsics/ishftc.c Sat May 19 01:04:03 2007 --- gcc-4.4.0/libgfortran/intrinsics/ishftc.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of ishftc intrinsic. ! Copyright 2002, 2004 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of ishftc intrinsic. ! Copyright 2002, 2004, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/iso_c_binding.c gcc-4.4.0/libgfortran/intrinsics/iso_c_binding.c *** gcc-4.3.3/libgfortran/intrinsics/iso_c_binding.c Mon Oct 15 19:58:55 2007 --- gcc-4.4.0/libgfortran/intrinsics/iso_c_binding.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the ISO_C_BINDING library helper functions. ! Copyright (C) 2007 Free Software Foundation, Inc. Contributed by Christopher Rickett. This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the ISO_C_BINDING library helper functions. ! Copyright (C) 2007, 2009 Free Software Foundation, Inc. Contributed by Christopher Rickett. This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ /* Implement the functions and subroutines provided by the intrinsic --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ /* Implement the functions and subroutines provided by the intrinsic *************** ISO_C_BINDING_PREFIX (c_f_pointer_d0) (v *** 180,195 **** | (GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT); } } - - - /* This function will change, once there is an actual f90 type for the - procedure pointer. */ - - void - ISO_C_BINDING_PREFIX (c_f_procpointer) (void *c_ptr_in, - gfc_array_void *f_ptr_out) - { - GFC_DESCRIPTOR_DATA(f_ptr_out) = c_ptr_in; - } - - --- 175,177 ---- diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/iso_c_binding.h gcc-4.4.0/libgfortran/intrinsics/iso_c_binding.h *** gcc-4.3.3/libgfortran/intrinsics/iso_c_binding.h Mon Oct 15 19:58:55 2007 --- gcc-4.4.0/libgfortran/intrinsics/iso_c_binding.h Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** ! /* Copyright (C) 2007 Free Software Foundation, Inc. Contributed by Christopher Rickett. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with Libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ /* Declarations for ISO_C_BINDING library helper functions. */ --- 1,26 ---- ! /* Copyright (C) 2007, 2009 Free Software Foundation, Inc. Contributed by Christopher Rickett. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ /* Declarations for ISO_C_BINDING library helper functions. */ *************** c_funptr_t; *** 52,61 **** void ISO_C_BINDING_PREFIX(c_f_pointer)(void *, gfc_array_void *, const array_t *, int, int); - /* The second param here may change, once procedure pointers are - implemented. */ - void ISO_C_BINDING_PREFIX(c_f_procpointer) (void *, gfc_array_void *); - void ISO_C_BINDING_PREFIX(c_f_pointer_u0) (void *, gfc_array_void *, const array_t *); void ISO_C_BINDING_PREFIX(c_f_pointer_d0) (void *, gfc_array_void *, --- 47,52 ---- diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/iso_c_generated_procs.c gcc-4.4.0/libgfortran/intrinsics/iso_c_generated_procs.c *** gcc-4.3.3/libgfortran/intrinsics/iso_c_generated_procs.c Sat Jul 21 23:45:44 2007 --- gcc-4.4.0/libgfortran/intrinsics/iso_c_generated_procs.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the ISO_C_BINDING library helper generated functions. ! Copyright (C) 2007 Free Software Foundation, Inc. Contributed by Christopher Rickett. This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the ISO_C_BINDING library helper generated functions. ! Copyright (C) 2007, 2009 Free Software Foundation, Inc. Contributed by Christopher Rickett. This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/kill.c gcc-4.4.0/libgfortran/intrinsics/kill.c *** gcc-4.3.3/libgfortran/intrinsics/kill.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/kill.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the KILL g77 intrinsic. ! Copyright (C) 2005, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the KILL g77 intrinsic. ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/link.c gcc-4.4.0/libgfortran/intrinsics/link.c *** gcc-4.3.3/libgfortran/intrinsics/link.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/link.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the LINK intrinsic. ! Copyright (C) 2005, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the LINK intrinsic. ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/malloc.c gcc-4.4.0/libgfortran/intrinsics/malloc.c *** gcc-4.3.3/libgfortran/intrinsics/malloc.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/malloc.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MALLOC and FREE intrinsics ! Copyright (C) 2005, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MALLOC and FREE intrinsics ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/move_alloc.c gcc-4.4.0/libgfortran/intrinsics/move_alloc.c *** gcc-4.3.3/libgfortran/intrinsics/move_alloc.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/move_alloc.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Generic implementation of the MOVE_ALLOC intrinsic ! Copyright (C) 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Thomas This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Generic implementation of the MOVE_ALLOC intrinsic ! Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Thomas This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/mvbits.c gcc-4.4.0/libgfortran/intrinsics/mvbits.c *** gcc-4.3.3/libgfortran/intrinsics/mvbits.c Sat Jul 14 23:11:04 2007 --- gcc-4.4.0/libgfortran/intrinsics/mvbits.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the MVBITS intrinsic ! Copyright (C) 2004, 2006 Free Software Foundation, Inc. Contributed by Tobias Schlüter This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MVBITS intrinsic ! Copyright (C) 2004, 2006, 2009 Free Software Foundation, Inc. Contributed by Tobias Schlüter This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ /* TODO: This should be replaced by a compiler builtin. */ --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ /* TODO: This should be replaced by a compiler builtin. */ diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/pack_generic.c gcc-4.4.0/libgfortran/intrinsics/pack_generic.c *** gcc-4.3.3/libgfortran/intrinsics/pack_generic.c Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/intrinsics/pack_generic.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Generic implementation of the PACK intrinsic ! Copyright (C) 2002, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Generic implementation of the PACK intrinsic ! Copyright (C) 2002, 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** pack_internal (gfc_array_char *ret, cons *** 80,86 **** { /* r.* indicates the return array. */ index_type rstride0; ! char *rptr; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; --- 75,81 ---- { /* r.* indicates the return array. */ index_type rstride0; ! char * restrict rptr; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; *************** void *** 313,321 **** pack (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_l1 *mask, const gfc_array_char *vector) { ! pack_internal (ret, array, mask, vector, GFC_DESCRIPTOR_SIZE (array)); } extern void pack_char (gfc_array_char *, GFC_INTEGER_4, const gfc_array_char *, const gfc_array_l1 *, const gfc_array_char *, GFC_INTEGER_4, GFC_INTEGER_4); --- 308,458 ---- pack (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_l1 *mask, const gfc_array_char *vector) { ! index_type type_size; ! index_type size; ! ! type_size = GFC_DTYPE_TYPE_SIZE(array); ! ! switch(type_size) ! { ! case GFC_DTYPE_LOGICAL_1: ! case GFC_DTYPE_INTEGER_1: ! case GFC_DTYPE_DERIVED_1: ! pack_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) array, ! (gfc_array_l1 *) mask, (gfc_array_i1 *) vector); ! return; ! ! case GFC_DTYPE_LOGICAL_2: ! case GFC_DTYPE_INTEGER_2: ! pack_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) array, ! (gfc_array_l1 *) mask, (gfc_array_i2 *) vector); ! return; ! ! case GFC_DTYPE_LOGICAL_4: ! case GFC_DTYPE_INTEGER_4: ! ! pack_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) array, ! (gfc_array_l1 *) mask, (gfc_array_i4 *) vector); ! return; ! ! case GFC_DTYPE_LOGICAL_8: ! case GFC_DTYPE_INTEGER_8: ! ! pack_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) array, ! (gfc_array_l1 *) mask, (gfc_array_i8 *) vector); ! return; ! ! #ifdef HAVE_GFC_INTEGER_16 ! case GFC_DTYPE_LOGICAL_16: ! case GFC_DTYPE_INTEGER_16: ! ! pack_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) array, ! (gfc_array_l1 *) mask, (gfc_array_i16 *) vector); ! return; ! #endif ! case GFC_DTYPE_REAL_4: ! pack_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) array, ! (gfc_array_l1 *) mask, (gfc_array_r4 *) vector); ! return; ! ! case GFC_DTYPE_REAL_8: ! pack_r8 ((gfc_array_r8 *) ret, (gfc_array_r8 *) array, ! (gfc_array_l1 *) mask, (gfc_array_r8 *) vector); ! return; ! ! #ifdef HAVE_GFC_REAL_10 ! case GFC_DTYPE_REAL_10: ! pack_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) array, ! (gfc_array_l1 *) mask, (gfc_array_r10 *) vector); ! return; ! #endif ! ! #ifdef HAVE_GFC_REAL_16 ! case GFC_DTYPE_REAL_16: ! pack_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) array, ! (gfc_array_l1 *) mask, (gfc_array_r16 *) vector); ! return; ! #endif ! case GFC_DTYPE_COMPLEX_4: ! pack_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) array, ! (gfc_array_l1 *) mask, (gfc_array_c4 *) vector); ! return; ! ! case GFC_DTYPE_COMPLEX_8: ! pack_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) array, ! (gfc_array_l1 *) mask, (gfc_array_c8 *) vector); ! return; ! ! #ifdef HAVE_GFC_COMPLEX_10 ! case GFC_DTYPE_COMPLEX_10: ! pack_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) array, ! (gfc_array_l1 *) mask, (gfc_array_c10 *) vector); ! return; ! #endif ! ! #ifdef HAVE_GFC_COMPLEX_16 ! case GFC_DTYPE_COMPLEX_16: ! pack_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) array, ! (gfc_array_l1 *) mask, (gfc_array_c16 *) vector); ! return; ! #endif ! ! /* For derived types, let's check the actual alignment of the ! data pointers. If they are aligned, we can safely call ! the unpack functions. */ ! ! case GFC_DTYPE_DERIVED_2: ! if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(array->data) ! || GFC_UNALIGNED_2(vector->data)) ! break; ! else ! { ! pack_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) array, ! (gfc_array_l1 *) mask, (gfc_array_i2 *) vector); ! return; ! } ! ! case GFC_DTYPE_DERIVED_4: ! if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(array->data) ! || GFC_UNALIGNED_4(vector->data)) ! break; ! else ! { ! pack_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) array, ! (gfc_array_l1 *) mask, (gfc_array_i4 *) vector); ! return; ! } ! ! case GFC_DTYPE_DERIVED_8: ! if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(array->data) ! || GFC_UNALIGNED_8(vector->data)) ! break; ! else ! { ! pack_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) array, ! (gfc_array_l1 *) mask, (gfc_array_i8 *) vector); ! } ! ! #ifdef HAVE_GFC_INTEGER_16 ! case GFC_DTYPE_DERIVED_16: ! if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(array->data) ! || GFC_UNALIGNED_16(vector->data)) ! break; ! else ! { ! pack_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) array, ! (gfc_array_l1 *) mask, (gfc_array_i16 *) vector); ! return; ! } ! #endif ! ! } ! ! size = GFC_DESCRIPTOR_SIZE (array); ! pack_internal (ret, array, mask, vector, size); } + extern void pack_char (gfc_array_char *, GFC_INTEGER_4, const gfc_array_char *, const gfc_array_l1 *, const gfc_array_char *, GFC_INTEGER_4, GFC_INTEGER_4); *************** pack_char (gfc_array_char *ret, *** 331,336 **** --- 468,490 ---- pack_internal (ret, array, mask, vector, array_length); } + + extern void pack_char4 (gfc_array_char *, GFC_INTEGER_4, const gfc_array_char *, + const gfc_array_l1 *, const gfc_array_char *, + GFC_INTEGER_4, GFC_INTEGER_4); + export_proto(pack_char4); + + void + pack_char4 (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *array, const gfc_array_l1 *mask, + const gfc_array_char *vector, GFC_INTEGER_4 array_length, + GFC_INTEGER_4 vector_length __attribute__((unused))) + { + pack_internal (ret, array, mask, vector, array_length * sizeof (gfc_char4_t)); + } + + static void pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, const GFC_LOGICAL_4 *mask, const gfc_array_char *vector, *************** pack_s (gfc_array_char *ret, const gfc_a *** 500,505 **** --- 654,660 ---- pack_s_internal (ret, array, mask, vector, GFC_DESCRIPTOR_SIZE (array)); } + extern void pack_s_char (gfc_array_char *ret, GFC_INTEGER_4, const gfc_array_char *array, const GFC_LOGICAL_4 *, const gfc_array_char *, GFC_INTEGER_4, *************** pack_s_char (gfc_array_char *ret, *** 515,517 **** --- 670,690 ---- { pack_s_internal (ret, array, mask, vector, array_length); } + + + extern void pack_s_char4 (gfc_array_char *ret, GFC_INTEGER_4, + const gfc_array_char *array, const GFC_LOGICAL_4 *, + const gfc_array_char *, GFC_INTEGER_4, + GFC_INTEGER_4); + export_proto(pack_s_char4); + + void + pack_s_char4 (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *array, const GFC_LOGICAL_4 *mask, + const gfc_array_char *vector, GFC_INTEGER_4 array_length, + GFC_INTEGER_4 vector_length __attribute__((unused))) + { + pack_s_internal (ret, array, mask, vector, + array_length * sizeof (gfc_char4_t)); + } diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/perror.c gcc-4.4.0/libgfortran/intrinsics/perror.c *** gcc-4.3.3/libgfortran/intrinsics/perror.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/perror.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the PERROR intrinsic. ! Copyright (C) 2005, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the PERROR intrinsic. ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/rand.c gcc-4.4.0/libgfortran/intrinsics/rand.c *** gcc-4.3.3/libgfortran/intrinsics/rand.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/rand.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the IRAND, RAND, and SRAND intrinsics. ! Copyright (C) 2004, 2005, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the IRAND, RAND, and SRAND intrinsics. ! Copyright (C) 2004, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ /* Simple multiplicative congruent algorithm. The period of this generator is approximately 2^31-1, which means that --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ /* Simple multiplicative congruent algorithm. The period of this generator is approximately 2^31-1, which means that diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/random.c gcc-4.4.0/libgfortran/intrinsics/random.c *** gcc-4.3.3/libgfortran/intrinsics/random.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/random.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RANDOM intrinsics ! Copyright 2002, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Lars Segerlund and Steve Kargl. --- 1,5 ---- /* Implementation of the RANDOM intrinsics ! Copyright 2002, 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Lars Segerlund and Steve Kargl. *************** This file is part of the GNU Fortran 95 *** 8,33 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 8,28 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** static __gthread_mutex_t random_lock; *** 75,82 **** GFC_REAL_* types in the range of [0,1). If GFC_REAL_*_RADIX are 2 or 16, respectively, we mask off the bits that don't fit into the correct GFC_REAL_*, convert to the real type, then multiply by the ! correct offset. ! */ static inline void --- 70,76 ---- GFC_REAL_* types in the range of [0,1). If GFC_REAL_*_RADIX are 2 or 16, respectively, we mask off the bits that don't fit into the correct GFC_REAL_*, convert to the real type, then multiply by the ! correct offset. */ static inline void *************** KISS algorithm. */ *** 214,221 **** We do this by using three generators with different seeds, the first one always for the most significant bits, the second one for bits 33..64 (if present in the REAL kind), and the third one ! (called twice) for REAL(16). ! */ #define GFC_SL(k, n) ((k)^((k)<<(n))) #define GFC_SR(k, n) ((k)^((k)>>(n))) --- 208,214 ---- We do this by using three generators with different seeds, the first one always for the most significant bits, the second one for bits 33..64 (if present in the REAL kind), and the third one ! (called twice) for REAL(16). */ #define GFC_SL(k, n) ((k)^((k)<<(n))) #define GFC_SR(k, n) ((k)^((k)>>(n))) *************** KISS algorithm. */ *** 229,236 **** with 0<=x<2^32, 0dim[0].ubound + 1 - put->dim[0].lbound)) < kiss_size) runtime_error ("Array size of PUT is too small."); ! /* This code now should do correct strides. */ for (i = 0; i < kiss_size; i++) ! kiss_seed[i] = (GFC_UINTEGER_4) put->data[i * put->dim[0].stride]; } /* Return the seed to GET data. */ --- 693,707 ---- if (((put->dim[0].ubound + 1 - put->dim[0].lbound)) < kiss_size) runtime_error ("Array size of PUT is too small."); ! /* We copy the seed given by the user. */ for (i = 0; i < kiss_size; i++) ! memcpy (seed + i * sizeof(GFC_UINTEGER_4), ! &(put->data[(kiss_size - 1 - i) * put->dim[0].stride]), ! sizeof(GFC_UINTEGER_4)); ! ! /* We put it after scrambling the bytes, to paper around users who ! provide seeds with quality only in the lower or upper part. */ ! scramble_seed ((unsigned char *) kiss_seed, seed, 4*kiss_size); } /* Return the seed to GET data. */ *************** random_seed_i4 (GFC_INTEGER_4 *size, gfc *** 689,697 **** if (((get->dim[0].ubound + 1 - get->dim[0].lbound)) < kiss_size) runtime_error ("Array size of GET is too small."); ! /* This code now should do correct strides. */ for (i = 0; i < kiss_size; i++) ! get->data[i * get->dim[0].stride] = (GFC_INTEGER_4) kiss_seed[i]; } __gthread_mutex_unlock (&random_lock); --- 715,728 ---- if (((get->dim[0].ubound + 1 - get->dim[0].lbound)) < kiss_size) runtime_error ("Array size of GET is too small."); ! /* Unscramble the seed. */ ! unscramble_seed (seed, (unsigned char *) kiss_seed, 4*kiss_size); ! ! /* Then copy it back to the user variable. */ for (i = 0; i < kiss_size; i++) ! memcpy (&(get->data[(kiss_size - 1 - i) * get->dim[0].stride]), ! seed + i * sizeof(GFC_UINTEGER_4), ! sizeof(GFC_UINTEGER_4)); } __gthread_mutex_unlock (&random_lock); diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/rename.c gcc-4.4.0/libgfortran/intrinsics/rename.c *** gcc-4.3.3/libgfortran/intrinsics/rename.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/rename.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RENAME intrinsic. ! Copyright (C) 2005, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the RENAME intrinsic. ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/reshape_generic.c gcc-4.4.0/libgfortran/intrinsics/reshape_generic.c *** gcc-4.3.3/libgfortran/intrinsics/reshape_generic.c Sun Nov 23 15:08:32 2008 --- gcc-4.4.0/libgfortran/intrinsics/reshape_generic.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Generic implementation of the RESHAPE intrinsic ! Copyright 2002, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Generic implementation of the RESHAPE intrinsic ! Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** reshape_internal (parray *ret, parray *s *** 49,55 **** index_type rsize; index_type rs; index_type rex; ! char *rptr; /* s.* indicates the source array. */ index_type scount[GFC_MAX_DIMENSIONS]; index_type sextent[GFC_MAX_DIMENSIONS]; --- 44,50 ---- index_type rsize; index_type rs; index_type rex; ! char * restrict rptr; /* s.* indicates the source array. */ index_type scount[GFC_MAX_DIMENSIONS]; index_type sextent[GFC_MAX_DIMENSIONS]; *************** reshape_internal (parray *ret, parray *s *** 69,75 **** const char *src; int n; int dim; ! int sempty, pempty; if (ret->data == NULL) { --- 64,87 ---- const char *src; int n; int dim; ! int sempty, pempty, shape_empty; ! index_type shape_data[GFC_MAX_DIMENSIONS]; ! ! rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; ! if (rdim != GFC_DESCRIPTOR_RANK(ret)) ! runtime_error("rank of return array incorrect in RESHAPE intrinsic"); ! ! shape_empty = 0; ! ! for (n = 0; n < rdim; n++) ! { ! shape_data[n] = shape->data[n * shape->dim[0].stride]; ! if (shape_data[n] <= 0) ! { ! shape_data[n] = 0; ! shape_empty = 1; ! } ! } if (ret->data == NULL) { *************** reshape_internal (parray *ret, parray *s *** 78,84 **** for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape->data[n * shape->dim[0].stride]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; --- 90,96 ---- for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape_data[n]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; *************** reshape_internal (parray *ret, parray *s *** 87,95 **** ret->data = internal_malloc_size ( rs * size ); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } else { ! rdim = GFC_DESCRIPTOR_RANK (ret); } rsize = 1; --- 99,192 ---- ret->data = internal_malloc_size ( rs * size ); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } else { ! pdim = 0; ! psize = 1; ! pempty = 1; ! pptr = NULL; ! } ! ! if (unlikely (compile_options.bounds_check)) ! { ! index_type ret_extent, source_extent; ! ! rs = 1; ! for (n = 0; n < rdim; n++) ! { ! rs *= shape_data[n]; ! ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; ! if (ret_extent != shape_data[n]) ! runtime_error("Incorrect extent in return value of RESHAPE" ! " intrinsic in dimension %ld: is %ld," ! " should be %ld", (long int) n+1, ! (long int) ret_extent, (long int) shape_data[n]); ! } ! ! source_extent = 1; ! sdim = GFC_DESCRIPTOR_RANK (source); ! for (n = 0; n < sdim; n++) ! { ! index_type se; ! se = source->dim[n].ubound + 1 - source->dim[0].lbound; ! source_extent *= se > 0 ? se : 0; ! } ! ! if (rs > source_extent && (!pad || pempty)) ! runtime_error("Incorrect size in SOURCE argument to RESHAPE" ! " intrinsic: is %ld, should be %ld", ! (long int) source_extent, (long int) rs); ! ! if (order) ! { ! int seen[GFC_MAX_DIMENSIONS]; ! index_type v; ! ! for (n = 0; n < rdim; n++) ! seen[n] = 0; ! ! for (n = 0; n < rdim; n++) ! { ! v = order->data[n * order->dim[0].stride] - 1; ! ! if (v < 0 || v >= rdim) ! runtime_error("Value %ld out of range in ORDER argument" ! " to RESHAPE intrinsic", (long int) v + 1); ! ! if (seen[v] != 0) ! runtime_error("Duplicate value %ld in ORDER argument to" ! " RESHAPE intrinsic", (long int) v + 1); ! ! seen[v] = 1; ! } ! } } rsize = 1; *************** reshape_internal (parray *ret, parray *s *** 104,110 **** rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; ! if (rextent[n] != shape->data[dim * shape->dim[0].stride]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) --- 201,207 ---- rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; ! if (rextent[n] != shape_data[dim]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) *************** reshape_internal (parray *ret, parray *s *** 135,171 **** ssize = 0; } - if (pad) - { - pdim = GFC_DESCRIPTOR_RANK (pad); - psize = 1; - pempty = 0; - for (n = 0; n < pdim; n++) - { - pcount[n] = 0; - pstride[n] = pad->dim[n].stride; - pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; - if (pextent[n] <= 0) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= size; --- 232,237 ---- *************** reshape (parray *ret, parray *source, sh *** 282,297 **** GFC_DESCRIPTOR_SIZE (source)); } ! extern void reshape_char (parray *, GFC_INTEGER_4, parray *, shape_type *, ! parray *, shape_type *, GFC_INTEGER_4, ! GFC_INTEGER_4); export_proto(reshape_char); void ! reshape_char (parray *ret, GFC_INTEGER_4 ret_length __attribute__((unused)), parray *source, shape_type *shape, parray *pad, ! shape_type *order, GFC_INTEGER_4 source_length, ! GFC_INTEGER_4 pad_length __attribute__((unused))) { reshape_internal (ret, source, shape, pad, order, source_length); } --- 348,380 ---- GFC_DESCRIPTOR_SIZE (source)); } ! ! extern void reshape_char (parray *, gfc_charlen_type, parray *, shape_type *, ! parray *, shape_type *, gfc_charlen_type, ! gfc_charlen_type); export_proto(reshape_char); void ! reshape_char (parray *ret, gfc_charlen_type ret_length __attribute__((unused)), parray *source, shape_type *shape, parray *pad, ! shape_type *order, gfc_charlen_type source_length, ! gfc_charlen_type pad_length __attribute__((unused))) { reshape_internal (ret, source, shape, pad, order, source_length); } + + + extern void reshape_char4 (parray *, gfc_charlen_type, parray *, shape_type *, + parray *, shape_type *, gfc_charlen_type, + gfc_charlen_type); + export_proto(reshape_char4); + + void + reshape_char4 (parray *ret, gfc_charlen_type ret_length __attribute__((unused)), + parray *source, shape_type *shape, parray *pad, + shape_type *order, gfc_charlen_type source_length, + gfc_charlen_type pad_length __attribute__((unused))) + { + reshape_internal (ret, source, shape, pad, order, + source_length * sizeof (gfc_char4_t)); + } diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/reshape_packed.c gcc-4.4.0/libgfortran/intrinsics/reshape_packed.c *** gcc-4.3.3/libgfortran/intrinsics/reshape_packed.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/reshape_packed.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the RESHAPE intrinsic for packed arrays ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the RESHAPE intrinsic for packed arrays ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" *************** Boston, MA 02110-1301, USA. */ *** 35,41 **** /* Reshape function where all arrays are packed. Basically just memcpy. */ void ! reshape_packed (char * ret, index_type rsize, const char * source, index_type ssize, const char * pad, index_type psize) { index_type size; --- 30,36 ---- /* Reshape function where all arrays are packed. Basically just memcpy. */ void ! reshape_packed (char * restrict ret, index_type rsize, const char * source, index_type ssize, const char * pad, index_type psize) { index_type size; diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/selected_char_kind.c gcc-4.4.0/libgfortran/intrinsics/selected_char_kind.c *** gcc-4.3.3/libgfortran/intrinsics/selected_char_kind.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/intrinsics/selected_char_kind.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,46 ---- + /* Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + + #include "libgfortran.h" + + #include + + + extern GFC_INTEGER_4 selected_char_kind (gfc_charlen_type, char *); + export_proto(selected_char_kind); + + GFC_INTEGER_4 + selected_char_kind (gfc_charlen_type name_len, char *name) + { + gfc_charlen_type len = fstrlen (name, name_len); + + if ((len == 5 && strncasecmp (name, "ascii", 5) == 0) + || (len == 7 && strncasecmp (name, "default", 7) == 0)) + return 1; + else if (len == 9 && strncasecmp (name, "iso_10646", 9) == 0) + return 1; + else + return -1; + } diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/selected_int_kind.f90 gcc-4.4.0/libgfortran/intrinsics/selected_int_kind.f90 *** gcc-4.3.3/libgfortran/intrinsics/selected_int_kind.f90 Sat Jan 20 18:33:20 2007 --- gcc-4.4.0/libgfortran/intrinsics/selected_int_kind.f90 Thu Apr 9 23:23:07 2009 *************** *** 1,23 **** ! ! Copyright 2003, 2004 Free Software Foundation, Inc. ! Contributed by Kejia Zhao ! ! !This file is part of the GNU Fortran 95 runtime library (libgfor). ! ! !GNU libgfor is free software; you can redistribute it and/or ! !modify it under the terms of the GNU Lesser General Public !License as published by the Free Software Foundation; either ! !version 2.1 of the License, or (at your option) any later version. ! ! !GNU libgfor is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! !GNU Lesser General Public License for more details. ! ! !You should have received a copy of the GNU Lesser General Public ! !License along with libgfor; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! function _gfortran_selected_int_kind (r) implicit none --- 1,26 ---- ! ! Copyright 2003, 2004, 2009 Free Software Foundation, Inc. ! Contributed by Kejia Zhao ! ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). ! ! !Libgfortran is free software; you can redistribute it and/or ! !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! ! !Libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! + !You should have received a copy of the GNU General Public License and + !a copy of the GCC Runtime Library Exception along with this program; + !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + !. function _gfortran_selected_int_kind (r) implicit none diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/selected_real_kind.f90 gcc-4.4.0/libgfortran/intrinsics/selected_real_kind.f90 *** gcc-4.3.3/libgfortran/intrinsics/selected_real_kind.f90 Sat Jan 20 18:33:20 2007 --- gcc-4.4.0/libgfortran/intrinsics/selected_real_kind.f90 Thu Apr 9 23:23:07 2009 *************** *** 1,23 **** ! ! Copyright 2003, 2004 Free Software Foundation, Inc. ! Contributed by Kejia Zhao ! ! !This file is part of the GNU Fortran 95 runtime library (libgfor). ! ! !GNU libgfor is free software; you can redistribute it and/or ! !modify it under the terms of the GNU Lesser General Public !License as published by the Free Software Foundation; either ! !version 2.1 of the License, or (at your option) any later version. ! ! !GNU libgfor is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! !GNU Lesser General Public License for more details. ! ! !You should have received a copy of the GNU Lesser General Public ! !License along with libgfor; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! function _gfortran_selected_real_kind (p, r) implicit none --- 1,26 ---- ! ! Copyright 2003, 2004, 2009 Free Software Foundation, Inc. ! Contributed by Kejia Zhao ! ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). ! ! !Libgfortran is free software; you can redistribute it and/or ! !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. ! ! !Libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! + !You should have received a copy of the GNU General Public License and + !a copy of the GCC Runtime Library Exception along with this program; + !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + !. function _gfortran_selected_real_kind (p, r) implicit none diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/signal.c gcc-4.4.0/libgfortran/intrinsics/signal.c *** gcc-4.3.3/libgfortran/intrinsics/signal.c Fri Oct 19 12:24:39 2007 --- gcc-4.4.0/libgfortran/intrinsics/signal.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SIGNAL and ALARM g77 intrinsics ! Copyright (C) 2005, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SIGNAL and ALARM g77 intrinsics ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" *************** Boston, MA 02110-1301, USA. */ *** 44,55 **** #include - #ifdef HAVE_INTPTR_T - # define INTPTR_T intptr_t - #else - # define INTPTR_T int - #endif - /* SIGNAL subroutine with PROCEDURE as handler */ extern void signal_sub (int *, void (*)(int), int *); iexport_proto(signal_sub); --- 39,44 ---- *************** void *** 58,68 **** signal_sub (int *number, void (*handler)(int), int *status) { #ifdef HAVE_SIGNAL ! INTPTR_T ret; if (status != NULL) { ! ret = (INTPTR_T) signal (*number, handler); *status = (int) ret; } else --- 47,57 ---- signal_sub (int *number, void (*handler)(int), int *status) { #ifdef HAVE_SIGNAL ! intptr_t ret; if (status != NULL) { ! ret = (intptr_t) signal (*number, handler); *status = (int) ret; } else *************** void *** 84,94 **** signal_sub_int (int *number, int *handler, int *status) { #ifdef HAVE_SIGNAL ! INTPTR_T ptr = *handler, ret; if (status != NULL) { ! ret = (INTPTR_T) signal (*number, (void (*)(int)) ptr); *status = (int) ret; } else --- 73,83 ---- signal_sub_int (int *number, int *handler, int *status) { #ifdef HAVE_SIGNAL ! intptr_t ptr = *handler, ret; if (status != NULL) { ! ret = (intptr_t) signal (*number, (void (*)(int)) ptr); *status = (int) ret; } else *************** alarm_sub_int_i4 (int *seconds __attribu *** 204,217 **** #if defined (SIGALRM) && defined (HAVE_ALARM) && defined (HAVE_SIGNAL) if (status != NULL) { ! if (signal (SIGALRM, (void (*)(int)) (INTPTR_T) *handler) == SIG_ERR) *status = -1; else *status = alarm (*seconds); } else { ! signal (SIGALRM, (void (*)(int)) (INTPTR_T) *handler); alarm (*seconds); } #else --- 193,206 ---- #if defined (SIGALRM) && defined (HAVE_ALARM) && defined (HAVE_SIGNAL) if (status != NULL) { ! if (signal (SIGALRM, (void (*)(int)) (intptr_t) *handler) == SIG_ERR) *status = -1; else *status = alarm (*seconds); } else { ! signal (SIGALRM, (void (*)(int)) (intptr_t) *handler); alarm (*seconds); } #else *************** alarm_sub_int_i8 (int *seconds __attribu *** 234,247 **** #if defined (SIGALRM) && defined (HAVE_ALARM) && defined (HAVE_SIGNAL) if (status != NULL) { ! if (signal (SIGALRM, (void (*)(int)) (INTPTR_T) *handler) == SIG_ERR) *status = -1; else *status = alarm (*seconds); } else { ! signal (SIGALRM, (void (*)(int)) (INTPTR_T) *handler); alarm (*seconds); } #else --- 223,236 ---- #if defined (SIGALRM) && defined (HAVE_ALARM) && defined (HAVE_SIGNAL) if (status != NULL) { ! if (signal (SIGALRM, (void (*)(int)) (intptr_t) *handler) == SIG_ERR) *status = -1; else *status = alarm (*seconds); } else { ! signal (SIGALRM, (void (*)(int)) (intptr_t) *handler); alarm (*seconds); } #else diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/size.c gcc-4.4.0/libgfortran/intrinsics/size.c *** gcc-4.3.3/libgfortran/intrinsics/size.c Wed Aug 17 02:49:08 2005 --- gcc-4.4.0/libgfortran/intrinsics/size.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the size intrinsic. ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the size intrinsic. ! Copyright 2002, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/sleep.c gcc-4.4.0/libgfortran/intrinsics/sleep.c *** gcc-4.3.3/libgfortran/intrinsics/sleep.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/sleep.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SLEEP intrinsic. ! Copyright (C) 2005, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SLEEP intrinsic. ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/spread_generic.c gcc-4.4.0/libgfortran/intrinsics/spread_generic.c *** gcc-4.3.3/libgfortran/intrinsics/spread_generic.c Thu Oct 18 21:25:21 2007 --- gcc-4.4.0/libgfortran/intrinsics/spread_generic.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Generic implementation of the SPREAD intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Generic implementation of the SPREAD intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** void *** 276,284 **** --- 271,409 ---- spread (gfc_array_char *ret, const gfc_array_char *source, const index_type *along, const index_type *pncopies) { + index_type type_size; + + type_size = GFC_DTYPE_TYPE_SIZE(ret); + switch(type_size) + { + case GFC_DTYPE_DERIVED_1: + case GFC_DTYPE_LOGICAL_1: + case GFC_DTYPE_INTEGER_1: + spread_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_LOGICAL_2: + case GFC_DTYPE_INTEGER_2: + spread_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_LOGICAL_4: + case GFC_DTYPE_INTEGER_4: + spread_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_LOGICAL_8: + case GFC_DTYPE_INTEGER_8: + spread_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) source, + *along, *pncopies); + return; + + #ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_LOGICAL_16: + case GFC_DTYPE_INTEGER_16: + spread_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) source, + *along, *pncopies); + return; + #endif + + case GFC_DTYPE_REAL_4: + spread_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_REAL_8: + spread_r8 ((gfc_array_r8 *) ret, (gfc_array_r8 *) source, + *along, *pncopies); + return; + + #ifdef GFC_HAVE_REAL_10 + case GFC_DTYPE_REAL_10: + spread_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) source, + *along, *pncopies); + return; + #endif + + #ifdef GFC_HAVE_REAL_16 + case GFC_DTYPE_REAL_16: + spread_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) source, + *along, *pncopies); + return; + #endif + + case GFC_DTYPE_COMPLEX_4: + spread_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_COMPLEX_8: + spread_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) source, + *along, *pncopies); + return; + + #ifdef GFC_HAVE_COMPLEX_10 + case GFC_DTYPE_COMPLEX_10: + spread_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) source, + *along, *pncopies); + return; + #endif + + #ifdef GFC_HAVE_COMPLEX_16 + case GFC_DTYPE_COMPLEX_16: + spread_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) source, + *along, *pncopies); + return; + #endif + + case GFC_DTYPE_DERIVED_2: + if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(source->data)) + break; + else + { + spread_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) source, + *along, *pncopies); + return; + } + + case GFC_DTYPE_DERIVED_4: + if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(source->data)) + break; + else + { + spread_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) source, + *along, *pncopies); + return; + } + + case GFC_DTYPE_DERIVED_8: + if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(source->data)) + break; + else + { + spread_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) source, + *along, *pncopies); + return; + } + + #ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_DERIVED_16: + if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(source->data)) + break; + else + { + spread_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) source, + *along, *pncopies); + return; + } + #endif + } + spread_internal (ret, source, along, pncopies, GFC_DESCRIPTOR_SIZE (source)); } + extern void spread_char (gfc_array_char *, GFC_INTEGER_4, const gfc_array_char *, const index_type *, const index_type *, GFC_INTEGER_4); *************** spread_char (gfc_array_char *ret, *** 293,298 **** --- 418,440 ---- spread_internal (ret, source, along, pncopies, source_length); } + + extern void spread_char4 (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, const index_type *, + const index_type *, GFC_INTEGER_4); + export_proto(spread_char4); + + void + spread_char4 (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *source, const index_type *along, + const index_type *pncopies, GFC_INTEGER_4 source_length) + { + spread_internal (ret, source, along, pncopies, + source_length * sizeof (gfc_char4_t)); + } + + /* The following are the prototypes for the versions of spread with a scalar source. */ *************** void *** 304,311 **** --- 446,582 ---- spread_scalar (gfc_array_char *ret, const char *source, const index_type *along, const index_type *pncopies) { + index_type type_size; + if (!ret->dtype) runtime_error ("return array missing descriptor in spread()"); + + type_size = GFC_DTYPE_TYPE_SIZE(ret); + switch(type_size) + { + case GFC_DTYPE_DERIVED_1: + case GFC_DTYPE_LOGICAL_1: + case GFC_DTYPE_INTEGER_1: + spread_scalar_i1 ((gfc_array_i1 *) ret, (GFC_INTEGER_1 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_LOGICAL_2: + case GFC_DTYPE_INTEGER_2: + spread_scalar_i2 ((gfc_array_i2 *) ret, (GFC_INTEGER_2 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_LOGICAL_4: + case GFC_DTYPE_INTEGER_4: + spread_scalar_i4 ((gfc_array_i4 *) ret, (GFC_INTEGER_4 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_LOGICAL_8: + case GFC_DTYPE_INTEGER_8: + spread_scalar_i8 ((gfc_array_i8 *) ret, (GFC_INTEGER_8 *) source, + *along, *pncopies); + return; + + #ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_LOGICAL_16: + case GFC_DTYPE_INTEGER_16: + spread_scalar_i16 ((gfc_array_i16 *) ret, (GFC_INTEGER_16 *) source, + *along, *pncopies); + return; + #endif + + case GFC_DTYPE_REAL_4: + spread_scalar_r4 ((gfc_array_r4 *) ret, (GFC_REAL_4 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_REAL_8: + spread_scalar_r8 ((gfc_array_r8 *) ret, (GFC_REAL_8 *) source, + *along, *pncopies); + return; + + #ifdef HAVE_GFC_REAL_10 + case GFC_DTYPE_REAL_10: + spread_scalar_r10 ((gfc_array_r10 *) ret, (GFC_REAL_10 *) source, + *along, *pncopies); + return; + #endif + + #ifdef HAVE_GFC_REAL_16 + case GFC_DTYPE_REAL_16: + spread_scalar_r16 ((gfc_array_r16 *) ret, (GFC_REAL_16 *) source, + *along, *pncopies); + return; + #endif + + case GFC_DTYPE_COMPLEX_4: + spread_scalar_c4 ((gfc_array_c4 *) ret, (GFC_COMPLEX_4 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_COMPLEX_8: + spread_scalar_c8 ((gfc_array_c8 *) ret, (GFC_COMPLEX_8 *) source, + *along, *pncopies); + return; + + #ifdef HAVE_GFC_COMPLEX_10 + case GFC_DTYPE_COMPLEX_10: + spread_scalar_c10 ((gfc_array_c10 *) ret, (GFC_COMPLEX_10 *) source, + *along, *pncopies); + return; + #endif + + #ifdef HAVE_GFC_COMPLEX_16 + case GFC_DTYPE_COMPLEX_16: + spread_scalar_c16 ((gfc_array_c16 *) ret, (GFC_COMPLEX_16 *) source, + *along, *pncopies); + return; + #endif + + case GFC_DTYPE_DERIVED_2: + if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(source)) + break; + else + { + spread_scalar_i2 ((gfc_array_i2 *) ret, (GFC_INTEGER_2 *) source, + *along, *pncopies); + return; + } + + case GFC_DTYPE_DERIVED_4: + if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(source)) + break; + else + { + spread_scalar_i4 ((gfc_array_i4 *) ret, (GFC_INTEGER_4 *) source, + *along, *pncopies); + return; + } + + case GFC_DTYPE_DERIVED_8: + if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(source)) + break; + else + { + spread_scalar_i8 ((gfc_array_i8 *) ret, (GFC_INTEGER_8 *) source, + *along, *pncopies); + return; + } + #ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_DERIVED_16: + if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(source)) + break; + else + { + spread_scalar_i16 ((gfc_array_i16 *) ret, (GFC_INTEGER_16 *) source, + *along, *pncopies); + return; + } + #endif + } + spread_internal_scalar (ret, source, along, pncopies, GFC_DESCRIPTOR_SIZE (ret)); } *************** spread_char_scalar (gfc_array_char *ret, *** 326,328 **** --- 597,617 ---- spread_internal_scalar (ret, source, along, pncopies, source_length); } + + extern void spread_char4_scalar (gfc_array_char *, GFC_INTEGER_4, + const char *, const index_type *, + const index_type *, GFC_INTEGER_4); + export_proto(spread_char4_scalar); + + void + spread_char4_scalar (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const char *source, const index_type *along, + const index_type *pncopies, GFC_INTEGER_4 source_length) + { + if (!ret->dtype) + runtime_error ("return array missing descriptor in spread()"); + spread_internal_scalar (ret, source, along, pncopies, + source_length * sizeof (gfc_char4_t)); + } + diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/stat.c gcc-4.4.0/libgfortran/intrinsics/stat.c *** gcc-4.3.3/libgfortran/intrinsics/stat.c Sat Dec 1 21:16:26 2007 --- gcc-4.4.0/libgfortran/intrinsics/stat.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the STAT and FSTAT intrinsics. ! Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the STAT and FSTAT intrinsics. ! Copyright (C) 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/string_intrinsics.c gcc-4.4.0/libgfortran/intrinsics/string_intrinsics.c *** gcc-4.3.3/libgfortran/intrinsics/string_intrinsics.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/string_intrinsics.c Thu Apr 9 23:23:07 2009 *************** *** 1,32 **** /* String intrinsics helper functions. ! Copyright 2002, 2005, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ /* Unlike what the name of this file suggests, we don't actually --- 1,26 ---- /* String intrinsics helper functions. ! Copyright 2008, 2009 Free Software Foundation, Inc. ! This file is part of the GNU Fortran runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ /* Unlike what the name of this file suggests, we don't actually *************** Boston, MA 02110-1301, USA. */ *** 42,419 **** #include ! /* String functions. */ ! ! extern void concat_string (GFC_INTEGER_4, char *, ! GFC_INTEGER_4, const char *, ! GFC_INTEGER_4, const char *); ! export_proto(concat_string); ! ! extern GFC_INTEGER_4 string_len_trim (GFC_INTEGER_4, const char *); ! export_proto(string_len_trim); ! ! extern void adjustl (char *, GFC_INTEGER_4, const char *); ! export_proto(adjustl); ! ! extern void adjustr (char *, GFC_INTEGER_4, const char *); ! export_proto(adjustr); ! ! extern GFC_INTEGER_4 string_index (GFC_INTEGER_4, const char *, GFC_INTEGER_4, ! const char *, GFC_LOGICAL_4); ! export_proto(string_index); ! ! extern GFC_INTEGER_4 string_scan (GFC_INTEGER_4, const char *, GFC_INTEGER_4, ! const char *, GFC_LOGICAL_4); ! export_proto(string_scan); ! ! extern GFC_INTEGER_4 string_verify (GFC_INTEGER_4, const char *, GFC_INTEGER_4, ! const char *, GFC_LOGICAL_4); ! export_proto(string_verify); ! ! extern void string_trim (GFC_INTEGER_4 *, void **, GFC_INTEGER_4, const char *); ! export_proto(string_trim); ! ! extern void string_minmax (GFC_INTEGER_4 *, void **, int, int, ...); ! export_proto(string_minmax); ! ! ! /* Use for functions which can return a zero-length string. */ ! static char zero_length_string = '\0'; ! ! ! /* Strings of unequal length are extended with pad characters. */ ! ! int ! compare_string (GFC_INTEGER_4 len1, const char * s1, ! GFC_INTEGER_4 len2, const char * s2) ! { ! int res; ! const unsigned char *s; ! int len; ! ! res = memcmp (s1, s2, (len1 < len2) ? len1 : len2); ! if (res != 0) ! return res; ! ! if (len1 == len2) ! return 0; ! ! if (len1 < len2) ! { ! len = len2 - len1; ! s = (unsigned char *) &s2[len1]; ! res = -1; ! } ! else ! { ! len = len1 - len2; ! s = (unsigned char *) &s1[len2]; ! res = 1; ! } ! ! while (len--) ! { ! if (*s != ' ') ! { ! if (*s > ' ') ! return res; ! else ! return -res; ! } ! s++; ! } ! ! return 0; ! } ! iexport(compare_string); ! ! ! /* The destination and source should not overlap. */ ! ! void ! concat_string (GFC_INTEGER_4 destlen, char * dest, ! GFC_INTEGER_4 len1, const char * s1, ! GFC_INTEGER_4 len2, const char * s2) ! { ! if (len1 >= destlen) ! { ! memcpy (dest, s1, destlen); ! return; ! } ! memcpy (dest, s1, len1); ! dest += len1; ! destlen -= len1; ! ! if (len2 >= destlen) ! { ! memcpy (dest, s2, destlen); ! return; ! } ! ! memcpy (dest, s2, len2); ! memset (&dest[len2], ' ', destlen - len2); ! } ! ! ! /* Return string with all trailing blanks removed. */ ! ! void ! string_trim (GFC_INTEGER_4 * len, void ** dest, GFC_INTEGER_4 slen, ! const char * src) ! { ! int i; ! ! /* Determine length of result string. */ ! for (i = slen - 1; i >= 0; i--) ! { ! if (src[i] != ' ') ! break; ! } ! *len = i + 1; ! ! if (*len == 0) ! *dest = &zero_length_string; ! else ! { ! /* Allocate space for result string. */ ! *dest = internal_malloc_size (*len); ! ! /* Copy string if necessary. */ ! memmove (*dest, src, *len); ! } ! } ! ! ! /* The length of a string not including trailing blanks. */ ! ! GFC_INTEGER_4 ! string_len_trim (GFC_INTEGER_4 len, const char * s) ! { ! int i; ! ! for (i = len - 1; i >= 0; i--) ! { ! if (s[i] != ' ') ! break; ! } ! return i + 1; ! } ! ! ! /* Find a substring within a string. */ ! ! GFC_INTEGER_4 ! string_index (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 sslen, ! const char * sstr, GFC_LOGICAL_4 back) ! { ! int start; ! int last; ! int i; ! int delta; ! ! if (sslen == 0) ! return 1; ! ! if (sslen > slen) ! return 0; ! ! if (!back) ! { ! last = slen + 1 - sslen; ! start = 0; ! delta = 1; ! } ! else ! { ! last = -1; ! start = slen - sslen; ! delta = -1; ! } ! i = 0; ! for (; start != last; start+= delta) ! { ! for (i = 0; i < sslen; i++) ! { ! if (str[start + i] != sstr[i]) ! break; ! } ! if (i == sslen) ! return (start + 1); ! } ! return 0; ! } ! ! ! /* Remove leading blanks from a string, padding at end. The src and dest ! should not overlap. */ ! ! void ! adjustl (char *dest, GFC_INTEGER_4 len, const char *src) ! { ! int i; ! ! i = 0; ! while (i 0) ! memset (&dest[len - i], ' ', i); ! } ! ! ! /* Remove trailing blanks from a string. */ ! ! void ! adjustr (char *dest, GFC_INTEGER_4 len, const char *src) ! { ! int i; ! ! i = len; ! while (i > 0 && src[i - 1] == ' ') ! i--; ! ! if (i < len) ! memset (dest, ' ', len - i); ! memcpy (dest + (len - i), src, i ); ! } ! ! ! /* Scan a string for any one of the characters in a set of characters. */ ! ! GFC_INTEGER_4 ! string_scan (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 setlen, ! const char * set, GFC_LOGICAL_4 back) ! { ! int i, j; ! ! if (slen == 0 || setlen == 0) ! return 0; ! ! if (back) ! { ! for (i = slen - 1; i >= 0; i--) ! { ! for (j = 0; j < setlen; j++) ! { ! if (str[i] == set[j]) ! return (i + 1); ! } ! } ! } ! else ! { ! for (i = 0; i < slen; i++) ! { ! for (j = 0; j < setlen; j++) ! { ! if (str[i] == set[j]) ! return (i + 1); ! } ! } ! } ! ! return 0; ! } ! ! ! /* Verify that a set of characters contains all the characters in a ! string by identifying the position of the first character in a ! characters that does not appear in a given set of characters. */ ! GFC_INTEGER_4 ! string_verify (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 setlen, ! const char * set, GFC_LOGICAL_4 back) { ! int start; ! int last; ! int i; ! int delta; ! ! if (slen == 0) ! return 0; ! if (back) ! { ! last = -1; ! start = slen - 1; ! delta = -1; ! } ! else ! { ! last = slen; ! start = 0; ! delta = 1; ! } ! for (; start != last; start += delta) ! { ! for (i = 0; i < setlen; i++) ! { ! if (str[start] == set[i]) ! break; ! } ! if (i == setlen) ! return (start + 1); ! } ! return 0; } ! /* MIN and MAX intrinsics for strings. The front-end makes sure that ! nargs is at least 2. */ ! ! void ! string_minmax (GFC_INTEGER_4 *rlen, void **dest, int op, int nargs, ...) ! { ! va_list ap; ! int i; ! char * next, * res; ! GFC_INTEGER_4 nextlen, reslen; ! ! va_start (ap, nargs); ! reslen = va_arg (ap, GFC_INTEGER_4); ! res = va_arg (ap, char *); ! *rlen = reslen; ! ! if (res == NULL) ! runtime_error ("First argument of '%s' intrinsic should be present", ! op > 0 ? "MAX" : "MIN"); ! for (i = 1; i < nargs; i++) ! { ! nextlen = va_arg (ap, GFC_INTEGER_4); ! next = va_arg (ap, char *); - if (next == NULL) - { - if (i == 1) - runtime_error ("Second argument of '%s' intrinsic should be " - "present", op > 0 ? "MAX" : "MIN"); - else - continue; - } ! if (nextlen > *rlen) ! *rlen = nextlen; ! if (op * compare_string (reslen, res, nextlen, next) < 0) ! { ! reslen = nextlen; ! res = next; ! } ! } ! va_end (ap); - if (*rlen == 0) - *dest = &zero_length_string; - else - { - char * tmp = internal_malloc_size (*rlen); - memcpy (tmp, res, reslen); - memset (&tmp[reslen], ' ', *rlen - reslen); - *dest = tmp; - } - } --- 36,80 ---- #include ! /* Helper function to set parts of wide strings to a constant (usually ! spaces). */ ! static gfc_char4_t * ! memset_char4 (gfc_char4_t *b, gfc_char4_t c, size_t len) { ! size_t i; ! for (i = 0; i < len; i++) ! b[i] = c; ! return b; } ! /* All other functions are defined using a few generic macros in ! string_intrinsics_inc.c, so we avoid code duplication between the ! various character type kinds. */ ! #undef CHARTYPE ! #define CHARTYPE char ! #undef UCHARTYPE ! #define UCHARTYPE unsigned char ! #undef SUFFIX ! #define SUFFIX(x) x ! #undef MEMSET ! #define MEMSET memset + #include "string_intrinsics_inc.c" ! #undef CHARTYPE ! #define CHARTYPE gfc_char4_t ! #undef UCHARTYPE ! #define UCHARTYPE gfc_char4_t ! #undef SUFFIX ! #define SUFFIX(x) x ## _char4 ! #undef MEMSET ! #define MEMSET memset_char4 ! #include "string_intrinsics_inc.c" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/string_intrinsics_inc.c gcc-4.4.0/libgfortran/intrinsics/string_intrinsics_inc.c *** gcc-4.3.3/libgfortran/intrinsics/string_intrinsics_inc.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/intrinsics/string_intrinsics_inc.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,413 ---- + /* String intrinsics helper functions. + Copyright 2002, 2005, 2007, 2008, 2009 Free Software Foundation, Inc. + + This file is part of the GNU Fortran runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + + /* Rename the functions. */ + #define concat_string SUFFIX(concat_string) + #define string_len_trim SUFFIX(string_len_trim) + #define adjustl SUFFIX(adjustl) + #define adjustr SUFFIX(adjustr) + #define string_index SUFFIX(string_index) + #define string_scan SUFFIX(string_scan) + #define string_verify SUFFIX(string_verify) + #define string_trim SUFFIX(string_trim) + #define string_minmax SUFFIX(string_minmax) + #define zero_length_string SUFFIX(zero_length_string) + #define compare_string SUFFIX(compare_string) + + + /* The prototypes. */ + + extern void concat_string (gfc_charlen_type, CHARTYPE *, + gfc_charlen_type, const CHARTYPE *, + gfc_charlen_type, const CHARTYPE *); + export_proto(concat_string); + + extern gfc_charlen_type string_len_trim (gfc_charlen_type, const CHARTYPE *); + export_proto(string_len_trim); + + extern void adjustl (CHARTYPE *, gfc_charlen_type, const CHARTYPE *); + export_proto(adjustl); + + extern void adjustr (CHARTYPE *, gfc_charlen_type, const CHARTYPE *); + export_proto(adjustr); + + extern gfc_charlen_type string_index (gfc_charlen_type, const CHARTYPE *, + gfc_charlen_type, const CHARTYPE *, + GFC_LOGICAL_4); + export_proto(string_index); + + extern gfc_charlen_type string_scan (gfc_charlen_type, const CHARTYPE *, + gfc_charlen_type, const CHARTYPE *, + GFC_LOGICAL_4); + export_proto(string_scan); + + extern gfc_charlen_type string_verify (gfc_charlen_type, const CHARTYPE *, + gfc_charlen_type, const CHARTYPE *, + GFC_LOGICAL_4); + export_proto(string_verify); + + extern void string_trim (gfc_charlen_type *, CHARTYPE **, gfc_charlen_type, + const CHARTYPE *); + export_proto(string_trim); + + extern void string_minmax (gfc_charlen_type *, CHARTYPE **, int, int, ...); + export_proto(string_minmax); + + + /* Use for functions which can return a zero-length string. */ + static CHARTYPE zero_length_string = 0; + + + /* Strings of unequal length are extended with pad characters. */ + + int + compare_string (gfc_charlen_type len1, const CHARTYPE *s1, + gfc_charlen_type len2, const CHARTYPE *s2) + { + const UCHARTYPE *s; + gfc_charlen_type len; + int res; + + res = memcmp (s1, s2, ((len1 < len2) ? len1 : len2) * sizeof (CHARTYPE)); + if (res != 0) + return res; + + if (len1 == len2) + return 0; + + if (len1 < len2) + { + len = len2 - len1; + s = (UCHARTYPE *) &s2[len1]; + res = -1; + } + else + { + len = len1 - len2; + s = (UCHARTYPE *) &s1[len2]; + res = 1; + } + + while (len--) + { + if (*s != ' ') + { + if (*s > ' ') + return res; + else + return -res; + } + s++; + } + + return 0; + } + iexport(compare_string); + + + /* The destination and source should not overlap. */ + + void + concat_string (gfc_charlen_type destlen, CHARTYPE * dest, + gfc_charlen_type len1, const CHARTYPE * s1, + gfc_charlen_type len2, const CHARTYPE * s2) + { + if (len1 >= destlen) + { + memcpy (dest, s1, destlen * sizeof (CHARTYPE)); + return; + } + memcpy (dest, s1, len1 * sizeof (CHARTYPE)); + dest += len1; + destlen -= len1; + + if (len2 >= destlen) + { + memcpy (dest, s2, destlen * sizeof (CHARTYPE)); + return; + } + + memcpy (dest, s2, len2 * sizeof (CHARTYPE)); + MEMSET (&dest[len2], ' ', destlen - len2); + } + + + /* Return string with all trailing blanks removed. */ + + void + string_trim (gfc_charlen_type *len, CHARTYPE **dest, gfc_charlen_type slen, + const CHARTYPE *src) + { + gfc_charlen_type i; + + /* Determine length of result string. */ + for (i = slen - 1; i >= 0; i--) + { + if (src[i] != ' ') + break; + } + *len = i + 1; + + if (*len == 0) + *dest = &zero_length_string; + else + { + /* Allocate space for result string. */ + *dest = internal_malloc_size (*len * sizeof (CHARTYPE)); + + /* Copy string if necessary. */ + memcpy (*dest, src, *len * sizeof (CHARTYPE)); + } + } + + + /* The length of a string not including trailing blanks. */ + + gfc_charlen_type + string_len_trim (gfc_charlen_type len, const CHARTYPE *s) + { + gfc_charlen_type i; + + for (i = len - 1; i >= 0; i--) + { + if (s[i] != ' ') + break; + } + return i + 1; + } + + + /* Find a substring within a string. */ + + gfc_charlen_type + string_index (gfc_charlen_type slen, const CHARTYPE *str, + gfc_charlen_type sslen, const CHARTYPE *sstr, + GFC_LOGICAL_4 back) + { + gfc_charlen_type start, last, delta, i; + + if (sslen == 0) + return back ? (slen + 1) : 1; + + if (sslen > slen) + return 0; + + if (!back) + { + last = slen + 1 - sslen; + start = 0; + delta = 1; + } + else + { + last = -1; + start = slen - sslen; + delta = -1; + } + + for (; start != last; start+= delta) + { + for (i = 0; i < sslen; i++) + { + if (str[start + i] != sstr[i]) + break; + } + if (i == sslen) + return (start + 1); + } + return 0; + } + + + /* Remove leading blanks from a string, padding at end. The src and dest + should not overlap. */ + + void + adjustl (CHARTYPE *dest, gfc_charlen_type len, const CHARTYPE *src) + { + gfc_charlen_type i; + + i = 0; + while (i < len && src[i] == ' ') + i++; + + if (i < len) + memcpy (dest, &src[i], (len - i) * sizeof (CHARTYPE)); + if (i > 0) + MEMSET (&dest[len - i], ' ', i); + } + + + /* Remove trailing blanks from a string. */ + + void + adjustr (CHARTYPE *dest, gfc_charlen_type len, const CHARTYPE *src) + { + gfc_charlen_type i; + + i = len; + while (i > 0 && src[i - 1] == ' ') + i--; + + if (i < len) + MEMSET (dest, ' ', len - i); + memcpy (&dest[len - i], src, i * sizeof (CHARTYPE)); + } + + + /* Scan a string for any one of the characters in a set of characters. */ + + gfc_charlen_type + string_scan (gfc_charlen_type slen, const CHARTYPE *str, + gfc_charlen_type setlen, const CHARTYPE *set, GFC_LOGICAL_4 back) + { + gfc_charlen_type i, j; + + if (slen == 0 || setlen == 0) + return 0; + + if (back) + { + for (i = slen - 1; i >= 0; i--) + { + for (j = 0; j < setlen; j++) + { + if (str[i] == set[j]) + return (i + 1); + } + } + } + else + { + for (i = 0; i < slen; i++) + { + for (j = 0; j < setlen; j++) + { + if (str[i] == set[j]) + return (i + 1); + } + } + } + + return 0; + } + + + /* Verify that a set of characters contains all the characters in a + string by identifying the position of the first character in a + characters that does not appear in a given set of characters. */ + + gfc_charlen_type + string_verify (gfc_charlen_type slen, const CHARTYPE *str, + gfc_charlen_type setlen, const CHARTYPE *set, + GFC_LOGICAL_4 back) + { + gfc_charlen_type start, last, delta, i; + + if (slen == 0) + return 0; + + if (back) + { + last = -1; + start = slen - 1; + delta = -1; + } + else + { + last = slen; + start = 0; + delta = 1; + } + for (; start != last; start += delta) + { + for (i = 0; i < setlen; i++) + { + if (str[start] == set[i]) + break; + } + if (i == setlen) + return (start + 1); + } + + return 0; + } + + + /* MIN and MAX intrinsics for strings. The front-end makes sure that + nargs is at least 2. */ + + void + string_minmax (gfc_charlen_type *rlen, CHARTYPE **dest, int op, int nargs, ...) + { + va_list ap; + int i; + CHARTYPE *next, *res; + gfc_charlen_type nextlen, reslen; + + va_start (ap, nargs); + reslen = va_arg (ap, gfc_charlen_type); + res = va_arg (ap, CHARTYPE *); + *rlen = reslen; + + if (res == NULL) + runtime_error ("First argument of '%s' intrinsic should be present", + op > 0 ? "MAX" : "MIN"); + + for (i = 1; i < nargs; i++) + { + nextlen = va_arg (ap, gfc_charlen_type); + next = va_arg (ap, CHARTYPE *); + + if (next == NULL) + { + if (i == 1) + runtime_error ("Second argument of '%s' intrinsic should be " + "present", op > 0 ? "MAX" : "MIN"); + else + continue; + } + + if (nextlen > *rlen) + *rlen = nextlen; + + if (op * compare_string (reslen, res, nextlen, next) < 0) + { + reslen = nextlen; + res = next; + } + } + va_end (ap); + + if (*rlen == 0) + *dest = &zero_length_string; + else + { + CHARTYPE *tmp = internal_malloc_size (*rlen * sizeof (CHARTYPE)); + memcpy (tmp, res, reslen * sizeof (CHARTYPE)); + MEMSET (&tmp[reslen], ' ', *rlen - reslen); + *dest = tmp; + } + } diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/symlnk.c gcc-4.4.0/libgfortran/intrinsics/symlnk.c *** gcc-4.3.3/libgfortran/intrinsics/symlnk.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/symlnk.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the SYMLNK intrinsic. ! Copyright (C) 2005, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the SYMLNK intrinsic. ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/system.c gcc-4.4.0/libgfortran/intrinsics/system.c *** gcc-4.3.3/libgfortran/intrinsics/system.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/system.c Thu Apr 9 23:23:07 2009 *************** *** 1,32 **** /* Implementation of the SYSTEM intrinsic. ! Copyright (C) 2004, 2007 Free Software Foundation, Inc. Contributed by Tobias Schlüter. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free ! Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combined - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with libgfortran; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #include "libgfortran.h" #include --- 1,27 ---- /* Implementation of the SYSTEM intrinsic. ! Copyright (C) 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Tobias Schlüter. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free ! Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/system_clock.c gcc-4.4.0/libgfortran/intrinsics/system_clock.c *** gcc-4.3.3/libgfortran/intrinsics/system_clock.c Sat Dec 1 21:16:26 2007 --- gcc-4.4.0/libgfortran/intrinsics/system_clock.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** /* Implementation of the SYSTEM_CLOCK intrinsic. ! Copyright (C) 2004, 2005, 2007 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 1,26 ---- /* Implementation of the SYSTEM_CLOCK intrinsic. ! Copyright (C) 2004, 2005, 2007, 2009 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/time.c gcc-4.4.0/libgfortran/intrinsics/time.c *** gcc-4.3.3/libgfortran/intrinsics/time.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/time.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the TIME and TIME8 g77 intrinsics. ! Copyright (C) 2005, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the TIME and TIME8 g77 intrinsics. ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/time_1.h gcc-4.4.0/libgfortran/intrinsics/time_1.h *** gcc-4.3.3/libgfortran/intrinsics/time_1.h Sat Mar 1 22:10:30 2008 --- gcc-4.4.0/libgfortran/intrinsics/time_1.h Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** /* Implementation of the CPU_TIME intrinsic. ! Copyright (C) 2003, 2007 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #ifndef LIBGFORTRAN_TIME_H #define LIBGFORTRAN_TIME_H --- 1,26 ---- /* Implementation of the CPU_TIME intrinsic. ! Copyright (C) 2003, 2007, 2009 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #ifndef LIBGFORTRAN_TIME_H #define LIBGFORTRAN_TIME_H *************** __time_1 (long *user_sec, long *user_use *** 87,93 **** } kernel_time, user_time; FILETIME unused1, unused2; - unsigned long long total_time; /* No support for Win9x. The high order bit of the DWORD returned by GetVersion is 0 for NT and higher. */ --- 82,87 ---- diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/transpose_generic.c gcc-4.4.0/libgfortran/intrinsics/transpose_generic.c *** gcc-4.3.3/libgfortran/intrinsics/transpose_generic.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/transpose_generic.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** transpose_internal (gfc_array_char *ret, *** 68,73 **** --- 63,91 ---- ret->data = internal_malloc_size (size * size0 ((array_t*)ret)); ret->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; + src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + } sxstride = source->dim[0].stride * size; systride = source->dim[1].stride * size; *************** transpose_internal (gfc_array_char *ret, *** 94,99 **** --- 112,118 ---- } } + extern void transpose (gfc_array_char *, gfc_array_char *); export_proto(transpose); *************** transpose (gfc_array_char *ret, gfc_arra *** 103,108 **** --- 122,128 ---- transpose_internal (ret, source, GFC_DESCRIPTOR_SIZE (source)); } + extern void transpose_char (gfc_array_char *, GFC_INTEGER_4, gfc_array_char *, GFC_INTEGER_4); export_proto(transpose_char); *************** transpose_char (gfc_array_char *ret, *** 114,116 **** --- 134,149 ---- { transpose_internal (ret, source, source_length); } + + + extern void transpose_char4 (gfc_array_char *, GFC_INTEGER_4, + gfc_array_char *, GFC_INTEGER_4); + export_proto(transpose_char4); + + void + transpose_char4 (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + gfc_array_char *source, GFC_INTEGER_4 source_length) + { + transpose_internal (ret, source, source_length * sizeof (gfc_char4_t)); + } diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/umask.c gcc-4.4.0/libgfortran/intrinsics/umask.c *** gcc-4.3.3/libgfortran/intrinsics/umask.c Sat Dec 1 21:16:26 2007 --- gcc-4.4.0/libgfortran/intrinsics/umask.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the UMASK intrinsic. ! Copyright (C) 2004, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the UMASK intrinsic. ! Copyright (C) 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/unlink.c gcc-4.4.0/libgfortran/intrinsics/unlink.c *** gcc-4.3.3/libgfortran/intrinsics/unlink.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/intrinsics/unlink.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the UNLINK intrinsic. ! Copyright (C) 2004, 2005, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the UNLINK intrinsic. ! Copyright (C) 2004, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/intrinsics/unpack_generic.c gcc-4.4.0/libgfortran/intrinsics/unpack_generic.c *** gcc-4.3.3/libgfortran/intrinsics/unpack_generic.c Thu Dec 27 15:00:10 2007 --- gcc-4.4.0/libgfortran/intrinsics/unpack_generic.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Generic implementation of the UNPACK intrinsic ! Copyright 2002, 2003, 2004, 2005, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Generic implementation of the UNPACK intrinsic ! Copyright 2002, 2003, 2004, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** unpack_internal (gfc_array_char *ret, co *** 42,48 **** index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type rs; ! char *rptr; /* v.* indicates the vector array. */ index_type vstride0; char *vptr; --- 37,43 ---- index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type rs; ! char * restrict rptr; /* v.* indicates the vector array. */ index_type vstride0; char *vptr; *************** void *** 196,206 **** unpack1 (gfc_array_char *ret, const gfc_array_char *vector, const gfc_array_l1 *mask, const gfc_array_char *field) { ! unpack_internal (ret, vector, mask, field, ! GFC_DESCRIPTOR_SIZE (vector), GFC_DESCRIPTOR_SIZE (field)); } extern void unpack1_char (gfc_array_char *, GFC_INTEGER_4, const gfc_array_char *, const gfc_array_l1 *, const gfc_array_char *, GFC_INTEGER_4, --- 191,336 ---- unpack1 (gfc_array_char *ret, const gfc_array_char *vector, const gfc_array_l1 *mask, const gfc_array_char *field) { ! index_type type_size; ! index_type size; ! ! type_size = GFC_DTYPE_TYPE_SIZE (vector); ! size = GFC_DESCRIPTOR_SIZE (vector); ! ! switch(type_size) ! { ! case GFC_DTYPE_LOGICAL_1: ! case GFC_DTYPE_INTEGER_1: ! case GFC_DTYPE_DERIVED_1: ! unpack1_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) vector, ! mask, (gfc_array_i1 *) field); ! return; ! ! case GFC_DTYPE_LOGICAL_2: ! case GFC_DTYPE_INTEGER_2: ! unpack1_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector, ! mask, (gfc_array_i2 *) field); ! return; ! ! case GFC_DTYPE_LOGICAL_4: ! case GFC_DTYPE_INTEGER_4: ! unpack1_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector, ! mask, (gfc_array_i4 *) field); ! return; ! ! case GFC_DTYPE_LOGICAL_8: ! case GFC_DTYPE_INTEGER_8: ! unpack1_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector, ! mask, (gfc_array_i8 *) field); ! return; ! ! #ifdef HAVE_GFC_INTEGER_16 ! case GFC_DTYPE_LOGICAL_16: ! case GFC_DTYPE_INTEGER_16: ! unpack1_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector, ! mask, (gfc_array_i16 *) field); ! return; ! #endif ! case GFC_DTYPE_REAL_4: ! unpack1_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) vector, ! mask, (gfc_array_r4 *) field); ! return; ! ! case GFC_DTYPE_REAL_8: ! unpack1_r8 ((gfc_array_r8 *) ret, (gfc_array_r8 *) vector, ! mask, (gfc_array_r8 *) field); ! return; ! ! #ifdef HAVE_GFC_REAL_10 ! case GFC_DTYPE_REAL_10: ! unpack1_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) vector, ! mask, (gfc_array_r10 *) field); ! return; ! #endif ! ! #ifdef HAVE_GFC_REAL_16 ! case GFC_DTYPE_REAL_16: ! unpack1_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) vector, ! mask, (gfc_array_r16 *) field); ! return; ! #endif ! ! case GFC_DTYPE_COMPLEX_4: ! unpack1_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) vector, ! mask, (gfc_array_c4 *) field); ! return; ! ! case GFC_DTYPE_COMPLEX_8: ! unpack1_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) vector, ! mask, (gfc_array_c8 *) field); ! return; ! ! #ifdef HAVE_GFC_COMPLEX_10 ! case GFC_DTYPE_COMPLEX_10: ! unpack1_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) vector, ! mask, (gfc_array_c10 *) field); ! return; ! #endif ! ! #ifdef HAVE_GFC_COMPLEX_16 ! case GFC_DTYPE_COMPLEX_16: ! unpack1_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) vector, ! mask, (gfc_array_c16 *) field); ! return; ! #endif ! ! case GFC_DTYPE_DERIVED_2: ! if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(vector->data) ! || GFC_UNALIGNED_2(field->data)) ! break; ! else ! { ! unpack1_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector, ! mask, (gfc_array_i2 *) field); ! return; ! } ! ! case GFC_DTYPE_DERIVED_4: ! if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(vector->data) ! || GFC_UNALIGNED_4(field->data)) ! break; ! else ! { ! unpack1_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector, ! mask, (gfc_array_i4 *) field); ! return; ! } ! ! case GFC_DTYPE_DERIVED_8: ! if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(vector->data) ! || GFC_UNALIGNED_8(field->data)) ! break; ! else ! { ! unpack1_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector, ! mask, (gfc_array_i8 *) field); ! return; ! } ! ! #ifdef HAVE_GFC_INTEGER_16 ! case GFC_DTYPE_DERIVED_16: ! if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(vector->data) ! || GFC_UNALIGNED_16(field->data)) ! break; ! else ! { ! unpack1_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector, ! mask, (gfc_array_i16 *) field); ! return; ! } ! #endif ! } ! ! unpack_internal (ret, vector, mask, field, size, GFC_DESCRIPTOR_SIZE (field)); } + extern void unpack1_char (gfc_array_char *, GFC_INTEGER_4, const gfc_array_char *, const gfc_array_l1 *, const gfc_array_char *, GFC_INTEGER_4, *************** unpack1_char (gfc_array_char *ret, *** 217,222 **** --- 347,372 ---- unpack_internal (ret, vector, mask, field, vector_length, field_length); } + + extern void unpack1_char4 (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, const gfc_array_l1 *, + const gfc_array_char *, GFC_INTEGER_4, + GFC_INTEGER_4); + export_proto(unpack1_char4); + + void + unpack1_char4 (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *vector, const gfc_array_l1 *mask, + const gfc_array_char *field, GFC_INTEGER_4 vector_length, + GFC_INTEGER_4 field_length) + { + unpack_internal (ret, vector, mask, field, + vector_length * sizeof (gfc_char4_t), + field_length * sizeof (gfc_char4_t)); + } + + extern void unpack0 (gfc_array_char *, const gfc_array_char *, const gfc_array_l1 *, char *); export_proto(unpack0); *************** unpack0 (gfc_array_char *ret, const gfc_ *** 227,238 **** --- 377,522 ---- { gfc_array_char tmp; + index_type type_size; + index_type size; + + type_size = GFC_DTYPE_TYPE_SIZE (vector); + size = GFC_DESCRIPTOR_SIZE (vector); + + switch(type_size) + { + case GFC_DTYPE_LOGICAL_1: + case GFC_DTYPE_INTEGER_1: + case GFC_DTYPE_DERIVED_1: + unpack0_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) vector, + mask, (GFC_INTEGER_1 *) field); + return; + + case GFC_DTYPE_LOGICAL_2: + case GFC_DTYPE_INTEGER_2: + unpack0_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector, + mask, (GFC_INTEGER_2 *) field); + return; + + case GFC_DTYPE_LOGICAL_4: + case GFC_DTYPE_INTEGER_4: + unpack0_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector, + mask, (GFC_INTEGER_4 *) field); + return; + + case GFC_DTYPE_LOGICAL_8: + case GFC_DTYPE_INTEGER_8: + unpack0_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector, + mask, (GFC_INTEGER_8 *) field); + return; + + #ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_LOGICAL_16: + case GFC_DTYPE_INTEGER_16: + unpack0_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector, + mask, (GFC_INTEGER_16 *) field); + return; + #endif + case GFC_DTYPE_REAL_4: + unpack0_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) vector, + mask, (GFC_REAL_4 *) field); + return; + + case GFC_DTYPE_REAL_8: + unpack0_r8 ((gfc_array_r8 *) ret, (gfc_array_r8*) vector, + mask, (GFC_REAL_8 *) field); + return; + + #ifdef HAVE_GFC_REAL_10 + case GFC_DTYPE_REAL_10: + unpack0_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) vector, + mask, (GFC_REAL_10 *) field); + return; + #endif + + #ifdef HAVE_GFC_REAL_16 + case GFC_DTYPE_REAL_16: + unpack0_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) vector, + mask, (GFC_REAL_16 *) field); + return; + #endif + + case GFC_DTYPE_COMPLEX_4: + unpack0_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) vector, + mask, (GFC_COMPLEX_4 *) field); + return; + + case GFC_DTYPE_COMPLEX_8: + unpack0_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) vector, + mask, (GFC_COMPLEX_8 *) field); + return; + + #ifdef HAVE_GFC_COMPLEX_10 + case GFC_DTYPE_COMPLEX_10: + unpack0_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) vector, + mask, (GFC_COMPLEX_10 *) field); + return; + #endif + + #ifdef HAVE_GFC_COMPLEX_16 + case GFC_DTYPE_COMPLEX_16: + unpack0_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) vector, + mask, (GFC_COMPLEX_16 *) field); + return; + #endif + case GFC_DTYPE_DERIVED_2: + if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(vector->data) + || GFC_UNALIGNED_2(field)) + break; + else + { + unpack0_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector, + mask, (GFC_INTEGER_2 *) field); + return; + } + + case GFC_DTYPE_DERIVED_4: + if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(vector->data) + || GFC_UNALIGNED_4(field)) + break; + else + { + unpack0_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector, + mask, (GFC_INTEGER_4 *) field); + return; + } + + case GFC_DTYPE_DERIVED_8: + if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(vector->data) + || GFC_UNALIGNED_8(field)) + break; + else + { + unpack0_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector, + mask, (GFC_INTEGER_8 *) field); + return; + } + #ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_DERIVED_16: + if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(vector->data) + || GFC_UNALIGNED_16(field)) + break; + else + { + unpack0_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector, + mask, (GFC_INTEGER_16 *) field); + return; + } + #endif + } + memset (&tmp, 0, sizeof (tmp)); tmp.dtype = 0; tmp.data = field; unpack_internal (ret, vector, mask, &tmp, GFC_DESCRIPTOR_SIZE (vector), 0); } + extern void unpack0_char (gfc_array_char *, GFC_INTEGER_4, const gfc_array_char *, const gfc_array_l1 *, char *, GFC_INTEGER_4, GFC_INTEGER_4); *************** unpack0_char (gfc_array_char *ret, *** 252,254 **** --- 536,560 ---- tmp.data = field; unpack_internal (ret, vector, mask, &tmp, vector_length, 0); } + + + extern void unpack0_char4 (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, const gfc_array_l1 *, + char *, GFC_INTEGER_4, GFC_INTEGER_4); + export_proto(unpack0_char4); + + void + unpack0_char4 (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *vector, const gfc_array_l1 *mask, + char *field, GFC_INTEGER_4 vector_length, + GFC_INTEGER_4 field_length __attribute__((unused))) + { + gfc_array_char tmp; + + memset (&tmp, 0, sizeof (tmp)); + tmp.dtype = 0; + tmp.data = field; + unpack_internal (ret, vector, mask, &tmp, + vector_length * sizeof (gfc_char4_t), 0); + } diff -Nrcpad gcc-4.3.3/libgfortran/io/close.c gcc-4.4.0/libgfortran/io/close.c *** gcc-4.3.3/libgfortran/io/close.c Mon Sep 3 16:44:15 2007 --- gcc-4.4.0/libgfortran/io/close.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** ! /* Copyright (C) 2002, 2003, 2005, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with Libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "io.h" #include --- 1,26 ---- ! /* Copyright (C) 2002, 2003, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "io.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/io/fbuf.c gcc-4.4.0/libgfortran/io/fbuf.c *** gcc-4.3.3/libgfortran/io/fbuf.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/io/fbuf.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,159 ---- + /* Copyright (C) 2008, 2009 Free Software Foundation, Inc. + Contributed by Janne Blomqvist + + This file is part of the GNU Fortran runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + + #include "io.h" + #include + #include + + + void + fbuf_init (gfc_unit * u, size_t len) + { + if (len == 0) + len = 512; /* Default size. */ + + u->fbuf = get_mem (sizeof (fbuf)); + u->fbuf->buf = get_mem (len); + u->fbuf->len = len; + u->fbuf->act = u->fbuf->flushed = u->fbuf->pos = 0; + } + + + void + fbuf_reset (gfc_unit * u) + { + u->fbuf->act = u->fbuf->flushed = u->fbuf->pos = 0; + } + + + void + fbuf_destroy (gfc_unit * u) + { + if (u->fbuf == NULL) + return; + if (u->fbuf->buf) + free_mem (u->fbuf->buf); + free_mem (u->fbuf); + } + + + /* Return a pointer to the current position in the buffer, and increase + the pointer by len. Makes sure that the buffer is big enough, + reallocating if necessary. If the buffer is not big enough, there are + three cases to consider: + 1. If we haven't flushed anything, realloc + 2. If we have flushed enough that by discarding the flushed bytes + the request fits into the buffer, do that. + 3. Else allocate a new buffer, memcpy unflushed active bytes from old + buffer. */ + + char * + fbuf_alloc (gfc_unit * u, size_t len) + { + size_t newlen; + char *dest; + if (u->fbuf->pos + len > u->fbuf->len) + { + if (u->fbuf->flushed == 0) + { + /* Round up to nearest multiple of the current buffer length. */ + newlen = ((u->fbuf->pos + len) / u->fbuf->len + 1) * u->fbuf->len; + dest = realloc (u->fbuf->buf, newlen); + if (dest == NULL) + return NULL; + u->fbuf->buf = dest; + u->fbuf->len = newlen; + } + else if (u->fbuf->act - u->fbuf->flushed + len < u->fbuf->len) + { + memmove (u->fbuf->buf, u->fbuf->buf + u->fbuf->flushed, + u->fbuf->act - u->fbuf->flushed); + u->fbuf->act -= u->fbuf->flushed; + u->fbuf->pos -= u->fbuf->flushed; + u->fbuf->flushed = 0; + } + else + { + /* Most general case, flushed != 0, request doesn't fit. */ + newlen = ((u->fbuf->pos - u->fbuf->flushed + len) + / u->fbuf->len + 1) * u->fbuf->len; + dest = get_mem (newlen); + memcpy (dest, u->fbuf->buf + u->fbuf->flushed, + u->fbuf->act - u->fbuf->flushed); + u->fbuf->act -= u->fbuf->flushed; + u->fbuf->pos -= u->fbuf->flushed; + u->fbuf->flushed = 0; + u->fbuf->buf = dest; + u->fbuf->len = newlen; + } + } + + dest = u->fbuf->buf + u->fbuf->pos; + u->fbuf->pos += len; + if (u->fbuf->pos > u->fbuf->act) + u->fbuf->act = u->fbuf->pos; + return dest; + } + + + + + int + fbuf_flush (gfc_unit * u, int record_done) + { + int status; + size_t nbytes; + + if (!u->fbuf) + return 0; + if (u->fbuf->act - u->fbuf->flushed != 0) + { + if (record_done) + nbytes = u->fbuf->act - u->fbuf->flushed; + else + nbytes = u->fbuf->pos - u->fbuf->flushed; + status = swrite (u->s, u->fbuf->buf + u->fbuf->flushed, &nbytes); + u->fbuf->flushed += nbytes; + } + else + status = 0; + if (record_done) + fbuf_reset (u); + return status; + } + + + int + fbuf_seek (gfc_unit * u, gfc_offset off) + { + gfc_offset pos = u->fbuf->pos + off; + /* Moving to the left past the flushed marked would imply moving past + the left tab limit, which is never allowed. So return error if + that is attempted. */ + if (pos < (gfc_offset) u->fbuf->flushed) + return -1; + u->fbuf->pos = pos; + return 0; + } diff -Nrcpad gcc-4.3.3/libgfortran/io/file_pos.c gcc-4.4.0/libgfortran/io/file_pos.c *** gcc-4.3.3/libgfortran/io/file_pos.c Thu Dec 13 19:35:09 2007 --- gcc-4.4.0/libgfortran/io/file_pos.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** ! /* Copyright (C) 2002-2003, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught and Janne Blomqvist This file is part of the GNU Fortran runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with Libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "io.h" #include --- 1,26 ---- ! /* Copyright (C) 2002-2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught and Janne Blomqvist This file is part of the GNU Fortran runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "io.h" #include *************** Boston, MA 02110-1301, USA. */ *** 39,52 **** record, and we have to sift backwards to find the newline before that or the start of the file, whichever comes first. */ ! #define READ_CHUNK 4096 static void formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u) { gfc_offset base; ! char *p; ! int n; base = file_position (u->s) - 1; --- 34,47 ---- record, and we have to sift backwards to find the newline before that or the start of the file, whichever comes first. */ ! static const int READ_CHUNK = 4096; static void formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u) { gfc_offset base; ! char p[READ_CHUNK]; ! size_t n; base = file_position (u->s) - 1; *************** formatted_backspace (st_parameter_filepo *** 54,62 **** { n = (base < READ_CHUNK) ? base : READ_CHUNK; base -= n; ! ! p = salloc_r_at (u->s, &n, base); ! if (p == NULL) goto io_error; /* We have moved backwards from the current position, it should --- 49,57 ---- { n = (base < READ_CHUNK) ? base : READ_CHUNK; base -= n; ! if (sseek (u->s, base) == FAILURE) ! goto io_error; ! if (sread (u->s, p, &n) != 0) goto io_error; /* We have moved backwards from the current position, it should *************** formatted_backspace (st_parameter_filepo *** 66,80 **** /* There is no memrchr() in the C library, so we have to do it ourselves. */ ! n--; ! while (n >= 0) { if (p[n] == '\n') { base += n + 1; goto done; } - n--; } } --- 61,74 ---- /* There is no memrchr() in the C library, so we have to do it ourselves. */ ! while (n > 0) { + n--; if (p[n] == '\n') { base += n + 1; goto done; } } } *************** unformatted_backspace (st_parameter_file *** 104,112 **** gfc_offset m, new; GFC_INTEGER_4 m4; GFC_INTEGER_8 m8; ! int length, length_read; int continued; ! char *p; if (compile_options.record_marker == 0) length = sizeof (GFC_INTEGER_4); --- 98,106 ---- gfc_offset m, new; GFC_INTEGER_4 m4; GFC_INTEGER_8 m8; ! size_t length; int continued; ! char p[sizeof (GFC_INTEGER_8)]; if (compile_options.record_marker == 0) length = sizeof (GFC_INTEGER_4); *************** unformatted_backspace (st_parameter_file *** 115,129 **** do { ! length_read = length; ! ! p = salloc_r_at (u->s, &length_read, ! file_position (u->s) - length); ! if (p == NULL || length_read != length) ! goto io_error; /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */ ! if (u->flags.convert == GFC_CONVERT_NATIVE) { switch (length) { --- 109,121 ---- do { ! if (sseek (u->s, file_position (u->s) - length) == FAILURE) ! goto io_error; ! if (sread (u->s, p, &length) != 0) ! goto io_error; /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */ ! if (likely (u->flags.convert == GFC_CONVERT_NATIVE)) { switch (length) { *************** st_backspace (st_parameter_filepos *fpp) *** 216,221 **** --- 208,216 ---- goto done; } + /* Make sure format buffer is flushed. */ + fbuf_flush (u, 1); + /* Check for special cases involving the ENDFILE record first. */ if (u->endfile == AFTER_ENDFILE) diff -Nrcpad gcc-4.3.3/libgfortran/io/format.c gcc-4.4.0/libgfortran/io/format.c *** gcc-4.3.3/libgfortran/io/format.c Mon Sep 3 16:44:15 2007 --- gcc-4.4.0/libgfortran/io/format.c Thu Apr 9 23:23:07 2009 *************** *** 1,32 **** ! /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with Libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ /* format.c-- parse a FORMAT string into a binary format suitable for --- 1,28 ---- ! /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught + F2003 I/O support contributed by Jerry DeLisle This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ /* format.c-- parse a FORMAT string into a binary format suitable for *************** typedef struct format_data *** 49,54 **** --- 45,51 ---- { char *format_string, *string; const char *error; + char error_element; format_token saved_token; int value, format_string_len, reversion_ok; fnode *avail; *************** static const fnode colon_node = { FMT_CO *** 66,77 **** static const char posint_required[] = "Positive width required in format", period_required[] = "Period required in format", nonneg_required[] = "Nonnegative width required in format", ! unexpected_element[] = "Unexpected element in format", unexpected_end[] = "Unexpected end of format string", bad_string[] = "Unterminated character constant in format", bad_hollerith[] = "Hollerith constant extends past the end of the format", ! reversion_error[] = "Exhausted data descriptors in format"; ! /* next_char()-- Return the next character in the format string. * Returns -1 when the string is done. If the literal flag is set, --- 63,74 ---- static const char posint_required[] = "Positive width required in format", period_required[] = "Period required in format", nonneg_required[] = "Nonnegative width required in format", ! unexpected_element[] = "Unexpected element '%c' in format\n", unexpected_end[] = "Unexpected end of format string", bad_string[] = "Unterminated character constant in format", bad_hollerith[] = "Hollerith constant extends past the end of the format", ! reversion_error[] = "Exhausted data descriptors in format", ! zero_width[] = "Zero width in format descriptor"; /* next_char()-- Return the next character in the format string. * Returns -1 when the string is done. If the literal flag is set, *************** next_char (format_data *fmt, int literal *** 88,94 **** return -1; fmt->format_string_len--; ! c = toupper (*fmt->format_string++); } while ((c == ' ' || c == '\t') && !literal); --- 85,91 ---- return -1; fmt->format_string_len--; ! fmt->error_element = c = toupper (*fmt->format_string++); } while ((c == ' ' || c == '\t') && !literal); *************** format_lex (format_data *fmt) *** 395,401 **** unget_char (fmt); break; } - break; case 'G': --- 392,397 ---- *************** format_lex (format_data *fmt) *** 415,421 **** break; case 'D': ! token = FMT_D; break; case -1: --- 411,429 ---- break; case 'D': ! switch (next_char (fmt, 0)) ! { ! case 'P': ! token = FMT_DP; ! break; ! case 'C': ! token = FMT_DC; ! break; ! default: ! token = FMT_D; ! unget_char (fmt); ! break; ! } break; case -1: *************** parse_format_list (st_parameter_dt *dtp) *** 550,555 **** --- 558,568 ---- tail->repeat = 1; goto optional_comma; + case FMT_DC: + case FMT_DP: + notify_std (&dtp->common, GFC_STD_F2003, "Fortran 2003: DC or DP " + "descriptor not allowed"); + /* Fall through. */ case FMT_S: case FMT_SS: case FMT_SP: *************** parse_format_list (st_parameter_dt *dtp) *** 576,581 **** --- 589,595 ---- notify_std (&dtp->common, GFC_STD_GNU, "Extension: $ descriptor"); goto between_desc; + case FMT_T: case FMT_TL: case FMT_TR: *************** parse_format_list (st_parameter_dt *dtp) *** 680,685 **** --- 694,705 ---- case FMT_A: t = format_lex (fmt); + if (t == FMT_ZERO) + { + fmt->error = zero_width; + goto finished; + } + if (t != FMT_POSINT) { fmt->saved_token = t; *************** parse_format_list (st_parameter_dt *dtp) *** 701,706 **** --- 721,751 ---- tail->repeat = repeat; u = format_lex (fmt); + if (t == FMT_G && u == FMT_ZERO) + { + if (notification_std (GFC_STD_F2008) == ERROR + || dtp->u.p.mode == READING) + { + fmt->error = zero_width; + goto finished; + } + tail->u.real.w = 0; + u = format_lex (fmt); + if (u != FMT_PERIOD) + { + fmt->saved_token = u; + break; + } + + u = format_lex (fmt); + if (u != FMT_POSINT) + { + fmt->error = posint_required; + goto finished; + } + tail->u.real.d = fmt->value; + break; + } if (t == FMT_F || dtp->u.p.mode == WRITING) { if (u != FMT_POSINT && u != FMT_ZERO) *************** format_error (st_parameter_dt *dtp, cons *** 913,919 **** if (f != NULL) fmt->format_string = f->source; ! sprintf (buffer, "%s\n", message); j = fmt->format_string - dtp->format; --- 958,967 ---- if (f != NULL) fmt->format_string = f->source; ! if (message == unexpected_element) ! sprintf (buffer, message, fmt->error_element); ! else ! sprintf (buffer, "%s\n", message); j = fmt->format_string - dtp->format; *************** next_format0 (fnode * f) *** 1061,1067 **** /* next_format()-- Return the next format node. If the format list * ends up being exhausted, we do reversion. Reversion is only ! * allowed if the we've seen a data descriptor since the * initialization or the last reversion. We return NULL if there * are no more data descriptors to return (which is an error * condition). */ --- 1109,1115 ---- /* next_format()-- Return the next format node. If the format list * ends up being exhausted, we do reversion. Reversion is only ! * allowed if we've seen a data descriptor since the * initialization or the last reversion. We return NULL if there * are no more data descriptors to return (which is an error * condition). */ diff -Nrcpad gcc-4.3.3/libgfortran/io/inquire.c gcc-4.4.0/libgfortran/io/inquire.c *** gcc-4.3.3/libgfortran/io/inquire.c Sun Jan 20 06:33:49 2008 --- gcc-4.4.0/libgfortran/io/inquire.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** ! /* Copyright (C) 2002, 2003, 2005, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with Libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ /* Implement the non-IOLENGTH variant of the INQUIRY statement */ --- 1,26 ---- ! /* Copyright (C) 2002, 2003, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ /* Implement the non-IOLENGTH variant of the INQUIRY statement */ *************** inquire_via_unit (st_parameter_inquire * *** 213,219 **** if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0) { ! if (u == NULL) p = undefined; else switch (u->flags.blank) --- 208,214 ---- if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0) { ! if (u == NULL || u->flags.form != FORM_FORMATTED) p = undefined; else switch (u->flags.blank) *************** inquire_via_unit (st_parameter_inquire * *** 231,236 **** --- 226,377 ---- cf_strcpy (iqp->blank, iqp->blank_len, p); } + if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0) + { + if (u == NULL || u->flags.form != FORM_FORMATTED) + p = undefined; + else + switch (u->flags.pad) + { + case PAD_YES: + p = "YES"; + break; + case PAD_NO: + p = "NO"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad pad"); + } + + cf_strcpy (iqp->pad, iqp->pad_len, p); + } + + if (cf & IOPARM_INQUIRE_HAS_FLAGS2) + { + GFC_INTEGER_4 cf2 = iqp->flags2; + + if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0) + *iqp->pending = 0; + + if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0) + *iqp->id = 0; + + if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0) + { + if (u == NULL || u->flags.form != FORM_FORMATTED) + p = undefined; + else + switch (u->flags.encoding) + { + case ENCODING_DEFAULT: + p = "UNKNOWN"; + break; + case ENCODING_UTF8: + p = "UTF-8"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad encoding"); + } + + cf_strcpy (iqp->encoding, iqp->encoding_len, p); + } + + if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0) + { + if (u == NULL || u->flags.form != FORM_FORMATTED) + p = undefined; + else + switch (u->flags.decimal) + { + case DECIMAL_POINT: + p = "POINT"; + break; + case DECIMAL_COMMA: + p = "COMMA"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad comma"); + } + + cf_strcpy (iqp->decimal, iqp->decimal_len, p); + } + + if ((cf2 & IOPARM_INQUIRE_HAS_ASYNCHRONOUS) != 0) + { + if (u == NULL) + p = undefined; + else + switch (u->flags.async) + { + case ASYNC_YES: + p = "YES"; + break; + case ASYNC_NO: + p = "NO"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad async"); + } + + cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p); + } + + if ((cf2 & IOPARM_INQUIRE_HAS_SIGN) != 0) + { + if (u == NULL) + p = undefined; + else + switch (u->flags.sign) + { + case SIGN_PROCDEFINED: + p = "PROCESSOR_DEFINED"; + break; + case SIGN_SUPPRESS: + p = "SUPPRESS"; + break; + case SIGN_PLUS: + p = "PLUS"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad sign"); + } + + cf_strcpy (iqp->sign, iqp->sign_len, p); + } + + if ((cf2 & IOPARM_INQUIRE_HAS_ROUND) != 0) + { + if (u == NULL) + p = undefined; + else + switch (u->flags.round) + { + case ROUND_UP: + p = "UP"; + break; + case ROUND_DOWN: + p = "DOWN"; + break; + case ROUND_ZERO: + p = "ZERO"; + break; + case ROUND_NEAREST: + p = "NEAREST"; + break; + case ROUND_COMPATIBLE: + p = "COMPATIBLE"; + break; + case ROUND_PROCDEFINED: + p = "PROCESSOR_DEFINED"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad round"); + } + + cf_strcpy (iqp->round, iqp->round_len, p); + } + } + if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0) { if (u == NULL || u->flags.access == ACCESS_DIRECT) *************** inquire_via_unit (st_parameter_inquire * *** 354,366 **** else switch (u->flags.convert) { ! /* l8_to_l4_offset is 0 for little-endian, 1 for big-endian. */ case GFC_CONVERT_NATIVE: ! p = l8_to_l4_offset ? "BIG_ENDIAN" : "LITTLE_ENDIAN"; break; case GFC_CONVERT_SWAP: ! p = l8_to_l4_offset ? "LITTLE_ENDIAN" : "BIG_ENDIAN"; break; default: --- 495,507 ---- else switch (u->flags.convert) { ! /* big_endian is 0 for little-endian, 1 for big-endian. */ case GFC_CONVERT_NATIVE: ! p = big_endian ? "BIG_ENDIAN" : "LITTLE_ENDIAN"; break; case GFC_CONVERT_SWAP: ! p = big_endian ? "LITTLE_ENDIAN" : "BIG_ENDIAN"; break; default: *************** inquire_via_filename (st_parameter_inqui *** 435,440 **** --- 576,607 ---- if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0) cf_strcpy (iqp->blank, iqp->blank_len, undefined); + if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0) + cf_strcpy (iqp->pad, iqp->pad_len, undefined); + + if (cf & IOPARM_INQUIRE_HAS_FLAGS2) + { + GFC_INTEGER_4 cf2 = iqp->flags2; + + if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0) + cf_strcpy (iqp->encoding, iqp->encoding_len, undefined); + + if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0) + cf_strcpy (iqp->delim, iqp->delim_len, undefined); + + if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0) + cf_strcpy (iqp->decimal, iqp->decimal_len, undefined); + + if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0) + cf_strcpy (iqp->delim, iqp->delim_len, undefined); + + if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0) + cf_strcpy (iqp->pad, iqp->pad_len, undefined); + + if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0) + cf_strcpy (iqp->encoding, iqp->encoding_len, undefined); + } + if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0) cf_strcpy (iqp->position, iqp->position_len, undefined); *************** inquire_via_filename (st_parameter_inqui *** 458,469 **** p = inquire_read (iqp->file, iqp->file_len); cf_strcpy (iqp->readwrite, iqp->readwrite_len, p); } - - if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0) - cf_strcpy (iqp->delim, iqp->delim_len, undefined); - - if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0) - cf_strcpy (iqp->pad, iqp->pad_len, undefined); } --- 625,630 ---- diff -Nrcpad gcc-4.3.3/libgfortran/io/intrinsics.c gcc-4.4.0/libgfortran/io/intrinsics.c *** gcc-4.3.3/libgfortran/io/intrinsics.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/io/intrinsics.c Thu Apr 9 23:23:07 2009 *************** *** 1,32 **** /* Implementation of the FGET, FGETC, FPUT, FPUTC, FLUSH FTELL, TTYNAM and ISATTY intrinsics. ! Copyright (C) 2005, 2007 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "io.h" --- 1,27 ---- /* Implementation of the FGET, FGETC, FPUT, FPUTC, FLUSH FTELL, TTYNAM and ISATTY intrinsics. ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "io.h" diff -Nrcpad gcc-4.3.3/libgfortran/io/io.h gcc-4.4.0/libgfortran/io/io.h *** gcc-4.3.3/libgfortran/io/io.h Thu Jan 3 19:49:38 2008 --- gcc-4.4.0/libgfortran/io/io.h Thu Apr 9 23:23:07 2009 *************** *** 1,12 **** ! /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, --- 1,13 ---- ! /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught + F2003 I/O support contributed by Jerry DeLisle This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, *************** but WITHOUT ANY WARRANTY; without even t *** 14,30 **** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with Libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ ! /* As a special exception, if you link this library with other files, ! some of which are compiled with GCC, to produce an executable, ! this library does not by itself cause the resulting executable ! to be covered by the GNU General Public License. ! This exception does not however invalidate any other reasons why ! the executable file might be covered by the GNU General Public License. */ #ifndef GFOR_IO_H #define GFOR_IO_H --- 15,28 ---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #ifndef GFOR_IO_H #define GFOR_IO_H *************** typedef enum *** 44,56 **** } bt; - struct st_parameter_dt; typedef struct stream { ! char *(*alloc_w_at) (struct stream *, int *, gfc_offset); ! char *(*alloc_r_at) (struct stream *, int *, gfc_offset); try (*sfree) (struct stream *); try (*close) (struct stream *); try (*seek) (struct stream *, gfc_offset); --- 42,52 ---- } bt; struct st_parameter_dt; typedef struct stream { ! char *(*alloc_w_at) (struct stream *, int *); try (*sfree) (struct stream *); try (*close) (struct stream *); try (*seek) (struct stream *, gfc_offset); *************** typedef struct stream *** 61,77 **** } stream; /* Macros for doing file I/O given a stream. */ #define sfree(s) ((s)->sfree)(s) #define sclose(s) ((s)->close)(s) ! #define salloc_r(s, len) ((s)->alloc_r_at)(s, len, -1) ! #define salloc_w(s, len) ((s)->alloc_w_at)(s, len, -1) ! ! #define salloc_r_at(s, len, where) ((s)->alloc_r_at)(s, len, where) ! #define salloc_w_at(s, len, where) ((s)->alloc_w_at)(s, len, where) #define sseek(s, pos) ((s)->seek)(s, pos) #define struncate(s) ((s)->trunc)(s) --- 57,72 ---- } stream; + typedef enum + { SYNC_BUFFERED, SYNC_UNBUFFERED, ASYNC } + io_mode; /* Macros for doing file I/O given a stream. */ #define sfree(s) ((s)->sfree)(s) #define sclose(s) ((s)->close)(s) ! #define salloc_w(s, len) ((s)->alloc_w_at)(s, len) #define sseek(s, pos) ((s)->seek)(s, pos) #define struncate(s) ((s)->trunc)(s) *************** typedef enum *** 205,210 **** --- 200,224 ---- unit_pad; typedef enum + { DECIMAL_POINT, DECIMAL_COMMA, DECIMAL_UNSPECIFIED } + unit_decimal; + + typedef enum + { ENCODING_UTF8, ENCODING_DEFAULT, ENCODING_UNSPECIFIED } + unit_encoding; + + typedef enum + { ROUND_UP, ROUND_DOWN, ROUND_ZERO, ROUND_NEAREST, ROUND_COMPATIBLE, + ROUND_PROCDEFINED, ROUND_UNSPECIFIED } + unit_round; + + /* NOTE: unit_sign must correspond with the sign_status enumerator in + st_parameter_dt to not break the ABI. */ + typedef enum + { SIGN_PROCDEFINED, SIGN_SUPPRESS, SIGN_PLUS, SIGN_UNSPECIFIED } + unit_sign; + + typedef enum { ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED } unit_advance; *************** typedef enum *** 212,217 **** --- 226,239 ---- {READING, WRITING} unit_mode; + typedef enum + { ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED } + unit_async; + + typedef enum + { SIGN_S, SIGN_SS, SIGN_SP } + unit_sign_s; + #define CHARACTER1(name) \ char * name; \ gfc_charlen_type name ## _len *************** typedef struct *** 233,238 **** --- 255,265 ---- CHARACTER1 (delim); CHARACTER2 (pad); CHARACTER1 (convert); + CHARACTER2 (decimal); + CHARACTER1 (encoding); + CHARACTER2 (round); + CHARACTER1 (sign); + CHARACTER2 (asynchronous); } st_parameter_open; *************** st_parameter_filepos; *** 275,280 **** --- 302,317 ---- #define IOPARM_INQUIRE_HAS_WRITE (1 << 28) #define IOPARM_INQUIRE_HAS_READWRITE (1 << 29) #define IOPARM_INQUIRE_HAS_CONVERT (1 << 30) + #define IOPARM_INQUIRE_HAS_FLAGS2 (1 << 31) + + #define IOPARM_INQUIRE_HAS_ASYNCHRONOUS (1 << 0) + #define IOPARM_INQUIRE_HAS_DECIMAL (1 << 1) + #define IOPARM_INQUIRE_HAS_ENCODING (1 << 2) + #define IOPARM_INQUIRE_HAS_ROUND (1 << 3) + #define IOPARM_INQUIRE_HAS_SIGN (1 << 4) + #define IOPARM_INQUIRE_HAS_PENDING (1 << 5) + #define IOPARM_INQUIRE_HAS_SIZE (1 << 6) + #define IOPARM_INQUIRE_HAS_ID (1 << 7) typedef struct { *************** typedef struct *** 299,304 **** --- 336,350 ---- CHARACTER1 (write); CHARACTER2 (readwrite); CHARACTER1 (convert); + GFC_INTEGER_4 flags2; + CHARACTER1 (asynchronous); + CHARACTER2 (decimal); + CHARACTER1 (encoding); + CHARACTER2 (round); + CHARACTER1 (sign); + GFC_INTEGER_4 *pending; + GFC_INTEGER_4 *size; + GFC_INTEGER_4 *id; } st_parameter_inquire; *************** struct format_data; *** 314,322 **** --- 360,379 ---- #define IOPARM_DT_HAS_ADVANCE (1 << 13) #define IOPARM_DT_HAS_INTERNAL_UNIT (1 << 14) #define IOPARM_DT_HAS_NAMELIST_NAME (1 << 15) + #define IOPARM_DT_HAS_ID (1 << 16) + #define IOPARM_DT_HAS_POS (1 << 17) + #define IOPARM_DT_HAS_ASYNCHRONOUS (1 << 18) + #define IOPARM_DT_HAS_BLANK (1 << 19) + #define IOPARM_DT_HAS_DECIMAL (1 << 20) + #define IOPARM_DT_HAS_DELIM (1 << 21) + #define IOPARM_DT_HAS_PAD (1 << 22) + #define IOPARM_DT_HAS_ROUND (1 << 23) + #define IOPARM_DT_HAS_SIGN (1 << 24) + #define IOPARM_DT_HAS_F2003 (1 << 25) /* Internal use bit. */ #define IOPARM_DT_IONML_SET (1 << 31) + typedef struct st_parameter_dt { st_parameter_common common; *************** typedef struct st_parameter_dt *** 337,347 **** size_t, size_t); struct gfc_unit *current_unit; /* Item number in a formatted data transfer. Also used in namelist ! read_logical as an index into line_buffer. */ int item_count; unit_mode mode; unit_blank blank_status; ! enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status; int scale_factor; int max_pos; /* Maximum righthand column written to. */ /* Number of skips + spaces to be done for T and X-editing. */ --- 394,404 ---- size_t, size_t); struct gfc_unit *current_unit; /* Item number in a formatted data transfer. Also used in namelist ! read_logical as an index into line_buffer. */ int item_count; unit_mode mode; unit_blank blank_status; ! unit_sign sign_status; int scale_factor; int max_pos; /* Maximum righthand column written to. */ /* Number of skips + spaces to be done for T and X-editing. */ *************** typedef struct st_parameter_dt *** 354,360 **** 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */ int sf_seen_eor; unit_advance advance_status; - unsigned reversion_flag : 1; /* Format reversion has occurred. */ unsigned first_item : 1; unsigned seen_dollar : 1; --- 411,416 ---- *************** typedef struct st_parameter_dt *** 376,382 **** character string is being read so don't use commas to shorten a formatted field width. */ unsigned sf_read_comma : 1; ! /* A namelist specific flag used to enable reading input from line_buffer for logical reads. */ unsigned line_buffer_enabled : 1; /* An internal unit specific flag used to identify that the associated --- 432,438 ---- character string is being read so don't use commas to shorten a formatted field width. */ unsigned sf_read_comma : 1; ! /* A namelist specific flag used to enable reading input from line_buffer for logical reads. */ unsigned line_buffer_enabled : 1; /* An internal unit specific flag used to identify that the associated *************** typedef struct st_parameter_dt *** 385,391 **** /* An internal unit specific flag to signify an EOF condition for list directed read. */ unsigned at_eof : 1; ! /* 16 unused bits. */ char last_char; char nml_delim; --- 441,449 ---- /* An internal unit specific flag to signify an EOF condition for list directed read. */ unsigned at_eof : 1; ! /* Used for g0 floating point output. */ ! unsigned g0_no_blanks : 1; ! /* 15 unused bits. */ char last_char; char nml_delim; *************** typedef struct st_parameter_dt *** 407,419 **** enough to hold a complex value (two reals) of the largest kind. */ char value[32]; ! gfc_offset size_used; } p; /* This pad size must be equal to the pad_size declared in trans-io.c (gfc_build_io_library_fndecls). The above structure must be smaller or equal to this array. */ char pad[16 * sizeof (char *) + 32 * sizeof (int)]; } u; } st_parameter_dt; --- 465,486 ---- enough to hold a complex value (two reals) of the largest kind. */ char value[32]; ! GFC_IO_INT size_used; } p; /* This pad size must be equal to the pad_size declared in trans-io.c (gfc_build_io_library_fndecls). The above structure must be smaller or equal to this array. */ char pad[16 * sizeof (char *) + 32 * sizeof (int)]; } u; + GFC_INTEGER_4 *id; + GFC_IO_INT pos; + CHARACTER1 (asynchronous); + CHARACTER2 (blank); + CHARACTER1 (decimal); + CHARACTER2 (delim); + CHARACTER1 (pad); + CHARACTER2 (round); + CHARACTER1 (sign); } st_parameter_dt; *************** extern char check_st_parameter_dt[sizeof *** 422,427 **** --- 489,504 ---- >= sizeof (((st_parameter_dt *) 0)->u.p) ? 1 : -1]; + #define IOPARM_WAIT_HAS_ID (1 << 7) + + typedef struct + { + st_parameter_common common; + CHARACTER1 (id); + } + st_parameter_wait; + + #undef CHARACTER1 #undef CHARACTER2 *************** typedef struct *** 438,447 **** --- 515,548 ---- unit_pad pad; unit_convert convert; int has_recl; + unit_decimal decimal; + unit_encoding encoding; + unit_round round; + unit_sign sign; + unit_async async; } unit_flags; + /* Formatting buffer. This is a temporary scratch buffer. Currently used only + by formatted writes. After every + formatted write statement, this buffer is flushed. This buffer is needed since + not all devices are seekable, and T or TL edit descriptors require + moving backwards in the record. However, advance='no' complicates the + situation, so the buffer must only be partially flushed from the end of the + last flush until the current position in the record. */ + + typedef struct fbuf + { + char *buf; /* Start of buffer. */ + size_t len; /* Length of buffer. */ + size_t act; /* Active bytes in buffer. */ + size_t flushed; /* Flushed bytes from beginning of buffer. */ + size_t pos; /* Current position in buffer. */ + } + fbuf; + + typedef struct gfc_unit { int unit_number; *************** typedef struct gfc_unit *** 459,464 **** --- 560,568 ---- unit_mode mode; unit_flags flags; + unit_pad pad_status; + unit_decimal decimal_status; + unit_delim delim_status; /* recl -- Record length of the file. last_record -- Last record number read or written *************** typedef struct gfc_unit *** 492,497 **** --- 596,604 ---- int file_len; char *file; + + /* Formatting buffer. */ + struct fbuf *fbuf; } gfc_unit; *************** typedef enum *** 504,510 **** FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL, FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING, FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F, ! FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END } format_token; --- 611,618 ---- FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL, FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING, FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F, ! FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_DC, ! FMT_DP } format_token; *************** internal_proto(free_format_data); *** 725,732 **** extern const char *type_name (bt); internal_proto(type_name); ! extern void *read_block (st_parameter_dt *, int *); ! internal_proto(read_block); extern char *read_sf (st_parameter_dt *, int *, int); internal_proto(read_sf); --- 833,840 ---- extern const char *type_name (bt); internal_proto(type_name); ! extern try read_block_form (st_parameter_dt *, void *, size_t *); ! internal_proto(read_block_form); extern char *read_sf (st_parameter_dt *, int *, int); internal_proto(read_sf); *************** internal_proto(next_record); *** 748,753 **** --- 856,864 ---- extern void reverse_memcpy (void *, const void *, size_t); internal_proto (reverse_memcpy); + extern void st_wait (st_parameter_wait *); + export_proto(st_wait); + /* read.c */ extern void set_integer (void *, GFC_INTEGER_LARGEST, int); *************** internal_proto(convert_real); *** 762,767 **** --- 873,881 ---- extern void read_a (st_parameter_dt *, const fnode *, char *, int); internal_proto(read_a); + extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, int); + internal_proto(read_a); + extern void read_f (st_parameter_dt *, const fnode *, char *, int); internal_proto(read_f); *************** internal_proto(namelist_write); *** 797,802 **** --- 911,919 ---- extern void write_a (st_parameter_dt *, const fnode *, const char *, int); internal_proto(write_a); + extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, int); + internal_proto(write_a_char4); + extern void write_b (st_parameter_dt *, const fnode *, const char *, int); internal_proto(write_b); *************** internal_proto(write_l); *** 824,829 **** --- 941,952 ---- extern void write_o (st_parameter_dt *, const fnode *, const char *, int); internal_proto(write_o); + extern void write_real (st_parameter_dt *, const char *, int); + internal_proto(write_real); + + extern void write_real_g0 (st_parameter_dt *, const char *, int, int); + internal_proto(write_real_g0); + extern void write_x (st_parameter_dt *, int, int); internal_proto(write_x); *************** internal_proto(size_from_real_kind); *** 841,846 **** --- 964,988 ---- extern size_t size_from_complex_kind (int); internal_proto(size_from_complex_kind); + /* fbuf.c */ + extern void fbuf_init (gfc_unit *, size_t); + internal_proto(fbuf_init); + + extern void fbuf_destroy (gfc_unit *); + internal_proto(fbuf_destroy); + + extern void fbuf_reset (gfc_unit *); + internal_proto(fbuf_reset); + + extern char * fbuf_alloc (gfc_unit *, size_t); + internal_proto(fbuf_alloc); + + extern int fbuf_flush (gfc_unit *, int); + internal_proto(fbuf_flush); + + extern int fbuf_seek (gfc_unit *, gfc_offset); + internal_proto(fbuf_seek); + /* lock.c */ extern void free_ionml (st_parameter_dt *); internal_proto(free_ionml); diff -Nrcpad gcc-4.3.3/libgfortran/io/list_read.c gcc-4.4.0/libgfortran/io/list_read.c *** gcc-4.3.3/libgfortran/io/list_read.c Wed Oct 29 04:44:15 2008 --- gcc-4.4.0/libgfortran/io/list_read.c Thu Apr 9 23:23:07 2009 *************** *** 1,32 **** ! /* Copyright (C) 2002, 2003, 2004, 2005, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught Namelist input contributed by Paul Thomas This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with Libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "io.h" --- 1,29 ---- ! /* Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008, 2009 ! Free Software Foundation, Inc. Contributed by Andy Vaught Namelist input contributed by Paul Thomas + F2003 I/O support contributed by Jerry DeLisle This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "io.h" *************** Boston, MA 02110-1301, USA. */ *** 52,63 **** case '5': case '6': case '7': case '8': case '9' #define CASE_SEPARATORS case ' ': case ',': case '/': case '\n': case '\t': \ ! case '\r' /* This macro assumes that we're operating on a variable. */ #define is_separator(c) (c == '/' || c == ',' || c == '\n' || c == ' ' \ ! || c == '\t' || c == '\r') /* Maximum repeat count. Less than ten times the maximum signed int32. */ --- 49,60 ---- case '5': case '6': case '7': case '8': case '9' #define CASE_SEPARATORS case ' ': case ',': case '/': case '\n': case '\t': \ ! case '\r': case ';' /* This macro assumes that we're operating on a variable. */ #define is_separator(c) (c == '/' || c == ',' || c == '\n' || c == ' ' \ ! || c == '\t' || c == '\r' || c == ';') /* Maximum repeat count. Less than ten times the maximum signed int32. */ *************** free_line (st_parameter_dt *dtp) *** 138,146 **** static char next_char (st_parameter_dt *dtp) { ! int length; gfc_offset record; ! char c, *p; if (dtp->u.p.last_char != '\0') { --- 135,143 ---- static char next_char (st_parameter_dt *dtp) { ! size_t length; gfc_offset record; ! char c; if (dtp->u.p.last_char != '\0') { *************** next_char (st_parameter_dt *dtp) *** 204,260 **** length = 1; ! p = salloc_r (dtp->u.p.current_unit->s, &length); ! if (is_stream_io (dtp)) dtp->u.p.current_unit->strm_pos++; if (is_internal_unit (dtp)) { if (is_array_io (dtp)) { ! /* End of record is handled in the next pass through, above. The ! check for NULL here is cautionary. */ ! if (p == NULL) { generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); return '\0'; ! } ! dtp->u.p.current_unit->bytes_left--; - c = *p; } else { ! if (p == NULL) longjmp (*dtp->u.p.eof_jump, 1); if (length == 0) ! c = '\n'; ! else ! c = *p; } } else { - if (p == NULL) - { - generate_error (&dtp->common, LIBERROR_OS, NULL); - return '\0'; - } if (length == 0) { ! if (dtp->u.p.advance_status == ADVANCE_NO) ! { ! if (dtp->u.p.current_unit->endfile == AT_ENDFILE) ! longjmp (*dtp->u.p.eof_jump, 1); ! dtp->u.p.current_unit->endfile = AT_ENDFILE; ! c = '\n'; ! } ! else longjmp (*dtp->u.p.eof_jump, 1); } - else - c = *p; } done: dtp->u.p.at_eol = (c == '\n' || c == '\r'); --- 201,247 ---- length = 1; ! if (sread (dtp->u.p.current_unit->s, &c, &length) != 0) ! { ! generate_error (&dtp->common, LIBERROR_OS, NULL); ! return '\0'; ! } ! if (is_stream_io (dtp) && length == 1) dtp->u.p.current_unit->strm_pos++; if (is_internal_unit (dtp)) { if (is_array_io (dtp)) { ! /* Check whether we hit EOF. */ ! if (length == 0) { generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); return '\0'; ! } dtp->u.p.current_unit->bytes_left--; } else { ! if (dtp->u.p.at_eof) longjmp (*dtp->u.p.eof_jump, 1); if (length == 0) ! { ! c = '\n'; ! dtp->u.p.at_eof = 1; ! } } } else { if (length == 0) { ! if (dtp->u.p.current_unit->endfile == AT_ENDFILE) longjmp (*dtp->u.p.eof_jump, 1); + dtp->u.p.current_unit->endfile = AT_ENDFILE; + c = '\n'; } } done: dtp->u.p.at_eol = (c == '\n' || c == '\r'); *************** eat_separator (st_parameter_dt *dtp) *** 327,332 **** --- 314,326 ---- switch (c) { case ',': + if (dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) + { + unget_char (dtp, c); + break; + } + /* Fall through. */ + case ';': dtp->u.p.comma_flag = 1; eat_spaces (dtp); break; *************** eat_separator (st_parameter_dt *dtp) *** 338,357 **** case '\r': dtp->u.p.at_eol = 1; n = next_char(dtp); ! if (n == '\n') { ! if (dtp->u.p.namelist_mode) ! { ! do ! c = next_char (dtp); ! while (c == '\n' || c == '\r' || c == ' '); ! unget_char (dtp, c); ! } } ! else ! unget_char (dtp, n); ! break; ! case '\n': dtp->u.p.at_eol = 1; if (dtp->u.p.namelist_mode) --- 332,343 ---- case '\r': dtp->u.p.at_eol = 1; n = next_char(dtp); ! if (n != '\n') { ! unget_char (dtp, n); ! break; } ! /* Fall through. */ case '\n': dtp->u.p.at_eol = 1; if (dtp->u.p.namelist_mode) *************** read_logical (st_parameter_dt *dtp, int *** 670,675 **** --- 656,662 ---- unget_char (dtp, c); break; + case '.': c = tolower (next_char (dtp)); switch (c) *************** parse_real (st_parameter_dt *dtp, void * *** 1075,1080 **** --- 1062,1070 ---- c = next_char (dtp); } + if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) + c = '.'; + if (!isdigit (c) && c != '.') { if (c == 'i' || c == 'I' || c == 'n' || c == 'N') *************** parse_real (st_parameter_dt *dtp, void * *** 1090,1095 **** --- 1080,1087 ---- for (;;) { c = next_char (dtp); + if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) + c = '.'; switch (c) { CASE_DIGITS: *************** eol_1: *** 1259,1265 **** else unget_char (dtp, c); ! if (next_char (dtp) != ',') goto bad_complex; eol_2: --- 1251,1258 ---- else unget_char (dtp, c); ! if (next_char (dtp) ! != (dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? ',' : ';')) goto bad_complex; eol_2: *************** read_real (st_parameter_dt *dtp, int len *** 1313,1318 **** --- 1306,1313 ---- seen_dp = 0; c = next_char (dtp); + if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) + c = '.'; switch (c) { CASE_DIGITS: *************** read_real (st_parameter_dt *dtp, int len *** 1348,1353 **** --- 1343,1350 ---- for (;;) { c = next_char (dtp); + if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) + c = '.'; switch (c) { CASE_DIGITS: *************** read_real (st_parameter_dt *dtp, int len *** 1355,1362 **** break; case '.': ! if (seen_dp) ! goto bad_real; seen_dp = 1; push_char (dtp, c); --- 1352,1359 ---- break; case '.': ! if (seen_dp) ! goto bad_real; seen_dp = 1; push_char (dtp, c); *************** read_real (st_parameter_dt *dtp, int len *** 1380,1386 **** goto got_repeat; CASE_SEPARATORS: ! if (c != '\n' && c != ',' && c != '\r') unget_char (dtp, c); goto done; --- 1377,1383 ---- goto got_repeat; CASE_SEPARATORS: ! if (c != '\n' && c != ',' && c != '\r' && c != ';') unget_char (dtp, c); goto done; *************** read_real (st_parameter_dt *dtp, int len *** 1412,1417 **** --- 1409,1417 ---- c = next_char (dtp); } + if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) + c = '.'; + if (!isdigit (c) && c != '.') { if (c == 'i' || c == 'I' || c == 'n' || c == 'N') *************** read_real (st_parameter_dt *dtp, int len *** 1434,1439 **** --- 1434,1441 ---- for (;;) { c = next_char (dtp); + if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) + c = '.'; switch (c) { CASE_DIGITS: *************** check_type (st_parameter_dt *dtp, bt typ *** 1668,1678 **** greater than one, we copy the data item multiple times. */ static void ! list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, ! size_t size) { char c; ! int m; jmp_buf eof_jump; dtp->u.p.namelist_mode = 0; --- 1670,1681 ---- greater than one, we copy the data item multiple times. */ static void ! list_formatted_read_scalar (st_parameter_dt *dtp, volatile bt type, void *p, ! int kind, size_t size) { char c; ! gfc_char4_t *q; ! int i, m; jmp_buf eof_jump; dtp->u.p.namelist_mode = 0; *************** list_formatted_read_scalar (st_parameter *** 1712,1720 **** } else { - if (dtp->u.p.input_complete) - goto cleanup; - if (dtp->u.p.repeat_count > 0) { if (check_type (dtp, type, kind)) --- 1715,1720 ---- *************** list_formatted_read_scalar (st_parameter *** 1722,1727 **** --- 1722,1730 ---- goto set_value; } + if (dtp->u.p.input_complete) + goto cleanup; + if (dtp->u.p.at_eol) finish_separator (dtp); else *************** list_formatted_read_scalar (st_parameter *** 1775,1791 **** case BT_CHARACTER: if (dtp->u.p.saved_string) ! { m = ((int) size < dtp->u.p.saved_used) ? (int) size : dtp->u.p.saved_used; ! memcpy (p, dtp->u.p.saved_string, m); ! } else /* Just delimiters encountered, nothing to copy but SPACE. */ m = 0; if (m < (int) size) ! memset (((char *) p) + m, ' ', size - m); break; case BT_NULL: --- 1778,1810 ---- case BT_CHARACTER: if (dtp->u.p.saved_string) ! { m = ((int) size < dtp->u.p.saved_used) ? (int) size : dtp->u.p.saved_used; ! if (kind == 1) ! memcpy (p, dtp->u.p.saved_string, m); ! else ! { ! q = (gfc_char4_t *) p; ! for (i = 0; i < m; i++) ! q[i] = (unsigned char) dtp->u.p.saved_string[i]; ! } ! } else /* Just delimiters encountered, nothing to copy but SPACE. */ m = 0; if (m < (int) size) ! { ! if (kind == 1) ! memset (((char *) p) + m, ' ', size - m); ! else ! { ! q = (gfc_char4_t *) p; ! for (i = m; i < (int) size; i++) ! q[i] = (unsigned char) ' '; ! } ! } break; case BT_NULL: *************** list_formatted_read (st_parameter_dt *dt *** 1806,1811 **** --- 1825,1832 ---- { size_t elem; char *tmp; + size_t stride = type == BT_CHARACTER ? + size * GFC_SIZE_OF_CHAR_KIND(kind) : size; tmp = (char *) p; *************** list_formatted_read (st_parameter_dt *dt *** 1813,1819 **** for (elem = 0; elem < nelems; elem++) { dtp->u.p.item_count++; ! list_formatted_read_scalar (dtp, type, tmp + size*elem, kind, size); } } --- 1834,1840 ---- for (elem = 0; elem < nelems; elem++) { dtp->u.p.item_count++; ! list_formatted_read_scalar (dtp, type, tmp + stride*elem, kind, size); } } *************** finish_list_read (st_parameter_dt *dtp) *** 1838,1843 **** --- 1859,1871 ---- c = next_char (dtp); } while (c != '\n'); + + if (dtp->u.p.current_unit->endfile != NO_ENDFILE) + { + generate_error (&dtp->common, LIBERROR_END, NULL); + dtp->u.p.current_unit->endfile = AFTER_ENDFILE; + dtp->u.p.current_unit->current_record = 0; + } } /* NAMELIST INPUT *************** nml_query (st_parameter_dt *dtp, char c) *** 2165,2170 **** --- 2193,2207 ---- namelist_info * nl; index_type len; char * p; + #ifdef HAVE_CRLF + static const index_type endlen = 3; + static const char endl[] = "\r\n"; + static const char nmlend[] = "&end\r\n"; + #else + static const index_type endlen = 2; + static const char endl[] = "\n"; + static const char nmlend[] = "&end\n"; + #endif if (dtp->u.p.current_unit->unit_number != options.stdin_unit) return; *************** nml_query (st_parameter_dt *dtp, char c) *** 2191,2249 **** /* "&namelist_name\n" */ len = dtp->namelist_name_len; ! #ifdef HAVE_CRLF ! p = write_block (dtp, len + 3); ! #else ! p = write_block (dtp, len + 2); ! #endif ! if (!p) ! goto query_return; memcpy (p, "&", 1); memcpy ((char*)(p + 1), dtp->namelist_name, len); ! #ifdef HAVE_CRLF ! memcpy ((char*)(p + len + 1), "\r\n", 2); ! #else ! memcpy ((char*)(p + len + 1), "\n", 1); ! #endif for (nl = dtp->u.p.ionml; nl; nl = nl->next) { /* " var_name\n" */ len = strlen (nl->var_name); ! #ifdef HAVE_CRLF ! p = write_block (dtp, len + 3); ! #else ! p = write_block (dtp, len + 2); ! #endif if (!p) goto query_return; memcpy (p, " ", 1); memcpy ((char*)(p + 1), nl->var_name, len); ! #ifdef HAVE_CRLF ! memcpy ((char*)(p + len + 1), "\r\n", 2); ! #else ! memcpy ((char*)(p + len + 1), "\n", 1); ! #endif } /* "&end\n" */ ! #ifdef HAVE_CRLF ! p = write_block (dtp, 6); ! #else ! p = write_block (dtp, 5); ! #endif ! if (!p) goto query_return; ! #ifdef HAVE_CRLF ! memcpy (p, "&end\r\n", 6); ! #else ! memcpy (p, "&end\n", 5); ! #endif } /* Flush the stream to force immediate output. */ flush (dtp->u.p.current_unit->s); unlock_unit (dtp->u.p.current_unit); } --- 2228,2262 ---- /* "&namelist_name\n" */ len = dtp->namelist_name_len; ! p = write_block (dtp, len + endlen); ! if (!p) ! goto query_return; memcpy (p, "&", 1); memcpy ((char*)(p + 1), dtp->namelist_name, len); ! memcpy ((char*)(p + len + 1), &endl, endlen - 1); for (nl = dtp->u.p.ionml; nl; nl = nl->next) { /* " var_name\n" */ len = strlen (nl->var_name); ! p = write_block (dtp, len + endlen); if (!p) goto query_return; memcpy (p, " ", 1); memcpy ((char*)(p + 1), nl->var_name, len); ! memcpy ((char*)(p + len + 1), &endl, endlen - 1); } /* "&end\n" */ ! p = write_block (dtp, endlen + 3); goto query_return; ! memcpy (p, &nmlend, endlen + 3); } /* Flush the stream to force immediate output. */ + fbuf_flush (dtp->u.p.current_unit, 1); flush (dtp->u.p.current_unit->s); unlock_unit (dtp->u.p.current_unit); } *************** get_name: *** 2781,2787 **** if (first_nl != NULL && first_nl->var_rank > 0) nl = first_nl; ! if (nml_read_obj (dtp, nl, 0, pprev_nl, nml_err_msg, nml_err_msg_size, clow, chigh) == FAILURE) goto nml_err_ret; --- 2794,2800 ---- if (first_nl != NULL && first_nl->var_rank > 0) nl = first_nl; ! if (nml_read_obj (dtp, nl, 0, pprev_nl, nml_err_msg, nml_err_msg_size, clow, chigh) == FAILURE) goto nml_err_ret; diff -Nrcpad gcc-4.3.3/libgfortran/io/lock.c gcc-4.4.0/libgfortran/io/lock.c *** gcc-4.3.3/libgfortran/io/lock.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/io/lock.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Thread/recursion locking ! Copyright 2002, 2003, 2004, 2005, 2007 Free Software Foundation, Inc. Contributed by Paul Brook and Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Thread/recursion locking ! Copyright 2002, 2003, 2004, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook and Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "io.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "io.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/io/open.c gcc-4.4.0/libgfortran/io/open.c *** gcc-4.3.3/libgfortran/io/open.c Mon Sep 3 16:44:15 2007 --- gcc-4.4.0/libgfortran/io/open.c Thu Apr 9 23:23:07 2009 *************** *** 1,32 **** ! /* Copyright (C) 2002, 2003, 2004, 2005, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with Libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "io.h" #include --- 1,28 ---- ! /* Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught + F2003 I/O support contributed by Jerry DeLisle This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "io.h" #include *************** static const st_option pad_opt[] = *** 97,102 **** --- 93,131 ---- { NULL, 0} }; + static const st_option decimal_opt[] = + { + { "point", DECIMAL_POINT}, + { "comma", DECIMAL_COMMA}, + { NULL, 0} + }; + + static const st_option encoding_opt[] = + { + { "utf-8", ENCODING_UTF8}, + { "default", ENCODING_DEFAULT}, + { NULL, 0} + }; + + static const st_option round_opt[] = + { + { "up", ROUND_UP}, + { "down", ROUND_DOWN}, + { "zero", ROUND_ZERO}, + { "nearest", ROUND_NEAREST}, + { "compatible", ROUND_COMPATIBLE}, + { "processor_defined", ROUND_PROCDEFINED}, + { NULL, 0} + }; + + static const st_option sign_opt[] = + { + { "plus", SIGN_PLUS}, + { "suppress", SIGN_SUPPRESS}, + { "processor_defined", SIGN_PROCDEFINED}, + { NULL, 0} + }; + static const st_option convert_opt[] = { { "native", GFC_CONVERT_NATIVE}, *************** static const st_option convert_opt[] = *** 106,111 **** --- 135,146 ---- { NULL, 0} }; + static const st_option async_opt[] = + { + { "yes", ASYNC_YES}, + { "no", ASYNC_NO}, + { NULL, 0} + }; /* Given a unit, test to see if the file is positioned at the terminal point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE. *************** edit_modes (st_parameter_open *opp, gfc_ *** 179,184 **** --- 214,239 ---- generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, "PAD parameter conflicts with UNFORMATTED form in " "OPEN statement"); + + if (flags->decimal != DECIMAL_UNSPECIFIED) + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "DECIMAL parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + + if (flags->encoding != ENCODING_UNSPECIFIED) + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "ENCODING parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + + if (flags->round != ROUND_UNSPECIFIED) + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "ROUND parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + + if (flags->sign != SIGN_UNSPECIFIED) + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "SIGN parameter conflicts with UNFORMATTED form in " + "OPEN statement"); } if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK) *************** edit_modes (st_parameter_open *opp, gfc_ *** 190,195 **** --- 245,260 ---- u->flags.delim = flags->delim; if (flags->pad != PAD_UNSPECIFIED) u->flags.pad = flags->pad; + if (flags->decimal != DECIMAL_UNSPECIFIED) + u->flags.decimal = flags->decimal; + if (flags->encoding != ENCODING_UNSPECIFIED) + u->flags.encoding = flags->encoding; + if (flags->async != ASYNC_UNSPECIFIED) + u->flags.async = flags->async; + if (flags->round != ROUND_UNSPECIFIED) + u->flags.round = flags->round; + if (flags->sign != SIGN_UNSPECIFIED) + u->flags.sign = flags->sign; } /* Reposition the file if necessary. */ *************** new_unit (st_parameter_open *opp, gfc_un *** 249,254 **** --- 314,326 ---- flags->form = (flags->access == ACCESS_SEQUENTIAL) ? FORM_FORMATTED : FORM_UNFORMATTED; + if (flags->async == ASYNC_UNSPECIFIED) + flags->async = ASYNC_NO; + + if (flags->status == STATUS_UNSPECIFIED) + flags->status = STATUS_UNKNOWN; + + /* Checks. */ if (flags->delim == DELIM_UNSPECIFIED) flags->delim = DELIM_NONE; *************** new_unit (st_parameter_open *opp, gfc_un *** 289,294 **** --- 361,422 ---- } } + if (flags->decimal == DECIMAL_UNSPECIFIED) + flags->decimal = DECIMAL_POINT; + else + { + if (flags->form == FORM_UNFORMATTED) + { + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "DECIMAL parameter conflicts with UNFORMATTED form " + "in OPEN statement"); + goto fail; + } + } + + if (flags->encoding == ENCODING_UNSPECIFIED) + flags->encoding = ENCODING_DEFAULT; + else + { + if (flags->form == FORM_UNFORMATTED) + { + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "ENCODING parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + goto fail; + } + } + + /* NB: the value for ROUND when it's not specified by the user does not + have to be PROCESSOR_DEFINED; the standard says that it is + processor dependent, and requires that it is one of the + possible value (see F2003, 9.4.5.13). */ + if (flags->round == ROUND_UNSPECIFIED) + flags->round = ROUND_PROCDEFINED; + else + { + if (flags->form == FORM_UNFORMATTED) + { + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "ROUND parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + goto fail; + } + } + + if (flags->sign == SIGN_UNSPECIFIED) + flags->sign = SIGN_PROCDEFINED; + else + { + if (flags->form == FORM_UNFORMATTED) + { + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "SIGN parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + goto fail; + } + } + if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT) { generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, *************** new_unit (st_parameter_open *opp, gfc_un *** 300,311 **** if (flags->position == POSITION_UNSPECIFIED) flags->position = POSITION_ASIS; - - if (flags->status == STATUS_UNSPECIFIED) - flags->status = STATUS_UNKNOWN; - - /* Checks. */ - if (flags->access == ACCESS_DIRECT && (opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) == 0) { --- 428,433 ---- *************** new_unit (st_parameter_open *opp, gfc_un *** 484,490 **** { u->maxrec = max_offset; u->recl = 1; ! u->strm_pos = 1; } memmove (u->file, opp->file, opp->file_len); --- 606,612 ---- { u->maxrec = max_offset; u->recl = 1; ! u->strm_pos = file_position (u->s) + 1; } memmove (u->file, opp->file, opp->file_len); *************** new_unit (st_parameter_open *opp, gfc_un *** 499,504 **** --- 621,639 ---- if (flags->status == STATUS_SCRATCH && opp->file != NULL) free_mem (opp->file); + + if (flags->form == FORM_FORMATTED && (flags->action != ACTION_READ)) + { + if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN)) + fbuf_init (u, u->recl); + else + fbuf_init (u, 0); + } + else + u->fbuf = NULL; + + + return u; cleanup: *************** st_open (st_parameter_open *opp) *** 607,612 **** --- 742,767 ---- find_option (&opp->common, opp->pad, opp->pad_len, pad_opt, "Bad PAD parameter in OPEN statement"); + flags.decimal = !(cf & IOPARM_OPEN_HAS_DECIMAL) ? DECIMAL_UNSPECIFIED : + find_option (&opp->common, opp->decimal, opp->decimal_len, + decimal_opt, "Bad DECIMAL parameter in OPEN statement"); + + flags.encoding = !(cf & IOPARM_OPEN_HAS_ENCODING) ? ENCODING_UNSPECIFIED : + find_option (&opp->common, opp->encoding, opp->encoding_len, + encoding_opt, "Bad ENCODING parameter in OPEN statement"); + + flags.async = !(cf & IOPARM_OPEN_HAS_ASYNCHRONOUS) ? ASYNC_UNSPECIFIED : + find_option (&opp->common, opp->asynchronous, opp->asynchronous_len, + async_opt, "Bad ASYNCHRONOUS parameter in OPEN statement"); + + flags.round = !(cf & IOPARM_OPEN_HAS_ROUND) ? ROUND_UNSPECIFIED : + find_option (&opp->common, opp->round, opp->round_len, + round_opt, "Bad ROUND parameter in OPEN statement"); + + flags.sign = !(cf & IOPARM_OPEN_HAS_SIGN) ? SIGN_UNSPECIFIED : + find_option (&opp->common, opp->sign, opp->sign_len, + sign_opt, "Bad SIGN parameter in OPEN statement"); + flags.form = !(cf & IOPARM_OPEN_HAS_FORM) ? FORM_UNSPECIFIED : find_option (&opp->common, opp->form, opp->form_len, form_opt, "Bad FORM parameter in OPEN statement"); *************** st_open (st_parameter_open *opp) *** 635,641 **** conv = compile_options.convert; } ! /* We use l8_to_l4_offset, which is 0 on little-endian machines and 1 on big-endian machines. */ switch (conv) { --- 790,796 ---- conv = compile_options.convert; } ! /* We use big_endian, which is 0 on little-endian machines and 1 on big-endian machines. */ switch (conv) { *************** st_open (st_parameter_open *opp) *** 644,654 **** break; case GFC_CONVERT_BIG: ! conv = l8_to_l4_offset ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP; break; case GFC_CONVERT_LITTLE: ! conv = l8_to_l4_offset ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE; break; default: --- 799,809 ---- break; case GFC_CONVERT_BIG: ! conv = big_endian ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP; break; case GFC_CONVERT_LITTLE: ! conv = big_endian ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE; break; default: diff -Nrcpad gcc-4.3.3/libgfortran/io/read.c gcc-4.4.0/libgfortran/io/read.c *** gcc-4.3.3/libgfortran/io/read.c Tue Dec 11 03:49:52 2007 --- gcc-4.4.0/libgfortran/io/read.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** ! /* Copyright (C) 2002, 2003, 2005, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with Libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "io.h" #include --- 1,27 ---- ! /* Copyright (C) 2002, 2003, 2005, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught + F2003 I/O support contributed by Jerry DeLisle This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "io.h" #include *************** Boston, MA 02110-1301, USA. */ *** 33,40 **** --- 29,39 ---- #include #include + typedef unsigned char uchar; + /* read.c -- Deal with formatted reads */ + /* set_integer()-- All of the integer assignments come here to * actually place the value into memory. */ *************** void *** 191,201 **** read_l (st_parameter_dt *dtp, const fnode *f, char *dest, int length) { char *p; ! int w; w = f->u.w; ! p = read_block (dtp, &w); ! if (p == NULL) return; while (*p == ' ') --- 190,202 ---- read_l (st_parameter_dt *dtp, const fnode *f, char *dest, int length) { char *p; ! size_t w; w = f->u.w; ! ! p = gfc_alloca (w); ! ! if (read_block_form (dtp, p, &w) == FAILURE) return; while (*p == ' ') *************** read_l (st_parameter_dt *dtp, const fnod *** 232,266 **** } ! /* read_a()-- Read a character record. This one is pretty easy. */ ! void ! read_a (st_parameter_dt *dtp, const fnode *f, char *p, int length) { ! char *source; ! int w, m, n; ! w = f->u.w; ! if (w == -1) /* '(A)' edit descriptor */ ! w = length; ! dtp->u.p.sf_read_comma = 0; ! source = read_block (dtp, &w); ! dtp->u.p.sf_read_comma = 1; ! if (source == NULL) return; ! if (w > length) ! source += (w - length); ! m = (w > length) ? length : w; ! memcpy (p, source, m); ! n = length - w; if (n > 0) memset (p + m, ' ', n); } /* eat_leading_spaces()-- Given a character pointer and a width, * ignore the leading spaces. */ --- 233,471 ---- } ! static inline gfc_char4_t ! read_utf8 (st_parameter_dt *dtp, size_t *nbytes) ! { ! static const uchar masks[6] = { 0x7F, 0x1F, 0x0F, 0x07, 0x02, 0x01 }; ! static const uchar patns[6] = { 0x00, 0xC0, 0xE0, 0xF0, 0xF8, 0xFC }; ! static uchar buffer[6]; ! size_t i, nb, nread; ! gfc_char4_t c; ! int status; ! char *s; ! *nbytes = 1; ! s = (char *) &buffer[0]; ! status = read_block_form (dtp, s, nbytes); ! if (status == FAILURE) ! return 0; ! ! /* If this is a short read, just return. */ ! if (*nbytes == 0) ! return 0; ! ! c = buffer[0]; ! if (c < 0x80) ! return c; ! ! /* The number of leading 1-bits in the first byte indicates how many ! bytes follow. */ ! for (nb = 2; nb < 7; nb++) ! if ((c & ~masks[nb-1]) == patns[nb-1]) ! goto found; ! goto invalid; ! ! found: ! c = (c & masks[nb-1]); ! nread = nb - 1; ! ! s = (char *) &buffer[1]; ! status = read_block_form (dtp, s, &nread); ! if (status == FAILURE) ! return 0; ! /* Decode the bytes read. */ ! for (i = 1; i < nb; i++) ! { ! gfc_char4_t n = *s++; ! ! if ((n & 0xC0) != 0x80) ! goto invalid; ! ! c = ((c << 6) + (n & 0x3F)); ! } ! ! /* Make sure the shortest possible encoding was used. */ ! if (c <= 0x7F && nb > 1) goto invalid; ! if (c <= 0x7FF && nb > 2) goto invalid; ! if (c <= 0xFFFF && nb > 3) goto invalid; ! if (c <= 0x1FFFFF && nb > 4) goto invalid; ! if (c <= 0x3FFFFFF && nb > 5) goto invalid; ! ! /* Make sure the character is valid. */ ! if (c > 0x7FFFFFFF || (c >= 0xD800 && c <= 0xDFFF)) ! goto invalid; ! ! return c; ! ! invalid: ! generate_error (&dtp->common, LIBERROR_READ_VALUE, "Invalid UTF-8 encoding"); ! return (gfc_char4_t) '?'; ! } ! ! ! static void ! read_utf8_char1 (st_parameter_dt *dtp, char *p, int len, size_t width) { ! gfc_char4_t c; ! char *dest; ! size_t nbytes; ! int i, j; ! len = ((int) width < len) ? len : (int) width; ! dest = (char *) p; ! ! /* Proceed with decoding one character at a time. */ ! for (j = 0; j < len; j++, dest++) ! { ! c = read_utf8 (dtp, &nbytes); ! ! /* Check for a short read and if so, break out. */ ! if (nbytes == 0) ! break; ! ! *dest = c > 255 ? '?' : (uchar) c; ! } ! ! /* If there was a short read, pad the remaining characters. */ ! for (i = j; i < len; i++) ! *dest++ = ' '; ! return; ! } ! ! static void ! read_default_char1 (st_parameter_dt *dtp, char *p, int len, size_t width) ! { ! char *s; ! int m, n, status; ! ! s = gfc_alloca (width); ! ! status = read_block_form (dtp, s, &width); ! ! if (status == FAILURE) return; ! if (width > (size_t) len) ! s += (width - len); ! m = ((int) width > len) ? len : (int) width; ! memcpy (p, s, m); ! n = len - width; if (n > 0) memset (p + m, ' ', n); } + static void + read_utf8_char4 (st_parameter_dt *dtp, void *p, int len, size_t width) + { + gfc_char4_t *dest; + size_t nbytes; + int i, j; + + len = ((int) width < len) ? len : (int) width; + + dest = (gfc_char4_t *) p; + + /* Proceed with decoding one character at a time. */ + for (j = 0; j < len; j++, dest++) + { + *dest = read_utf8 (dtp, &nbytes); + + /* Check for a short read and if so, break out. */ + if (nbytes == 0) + break; + } + + /* If there was a short read, pad the remaining characters. */ + for (i = j; i < len; i++) + *dest++ = (gfc_char4_t) ' '; + return; + } + + + static void + read_default_char4 (st_parameter_dt *dtp, char *p, int len, size_t width) + { + char *s; + gfc_char4_t *dest; + int m, n, status; + + s = gfc_alloca (width); + + status = read_block_form (dtp, s, &width); + + if (status == FAILURE) + return; + if (width > (size_t) len) + s += (width - len); + + m = ((int) width > len) ? len : (int) width; + + dest = (gfc_char4_t *) p; + + for (n = 0; n < m; n++, dest++, s++) + *dest = (unsigned char ) *s; + + for (n = 0; n < len - (int) width; n++, dest++) + *dest = (unsigned char) ' '; + } + + + /* read_a()-- Read a character record into a KIND=1 character destination, + processing UTF-8 encoding if necessary. */ + + void + read_a (st_parameter_dt *dtp, const fnode *f, char *p, int length) + { + int wi; + size_t w; + + wi = f->u.w; + if (wi == -1) /* '(A)' edit descriptor */ + wi = length; + w = wi; + + /* Read in w characters, treating comma as not a separator. */ + dtp->u.p.sf_read_comma = 0; + + if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8) + read_utf8_char1 (dtp, p, length, w); + else + read_default_char1 (dtp, p, length, w); + + dtp->u.p.sf_read_comma = + dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA ? 0 : 1; + } + + + /* read_a_char4()-- Read a character record into a KIND=4 character destination, + processing UTF-8 encoding if necessary. */ + + void + read_a_char4 (st_parameter_dt *dtp, const fnode *f, char *p, int length) + { + int wi; + size_t w; + + wi = f->u.w; + if (wi == -1) /* '(A)' edit descriptor */ + wi = length; + w = wi; + + /* Read in w characters, treating comma as not a separator. */ + dtp->u.p.sf_read_comma = 0; + + if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8) + read_utf8_char4 (dtp, p, length, w); + else + read_default_char4 (dtp, p, length, w); + + dtp->u.p.sf_read_comma = + dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA ? 0 : 1; + } + /* eat_leading_spaces()-- Given a character pointer and a width, * ignore the leading spaces. */ *************** read_decimal (st_parameter_dt *dtp, cons *** 321,334 **** { GFC_UINTEGER_LARGEST value, maxv, maxv_10; GFC_INTEGER_LARGEST v; ! int w, negative; char c, *p; ! w = f->u.w; ! p = read_block (dtp, &w); ! if (p == NULL) return; p = eat_leading_spaces (&w, p); if (w == 0) { --- 526,544 ---- { GFC_UINTEGER_LARGEST value, maxv, maxv_10; GFC_INTEGER_LARGEST v; ! int w, negative; ! size_t wu; char c, *p; ! wu = f->u.w; ! ! p = gfc_alloca (wu); ! ! if (read_block_form (dtp, p, &wu) == FAILURE) return; + w = wu; + p = eat_leading_spaces (&w, p); if (w == 0) { *************** read_decimal (st_parameter_dt *dtp, cons *** 376,388 **** if (c < '0' || c > '9') goto bad; ! if (value > maxv_10) goto overflow; c -= '0'; value = 10 * value; ! if (value > maxv - c) goto overflow; value += c; } --- 586,598 ---- if (c < '0' || c > '9') goto bad; ! if (value > maxv_10 && compile_options.range_check == 1) goto overflow; c -= '0'; value = 10 * value; ! if (value > maxv - c && compile_options.range_check == 1) goto overflow; value += c; } *************** read_decimal (st_parameter_dt *dtp, cons *** 404,410 **** generate_error (&dtp->common, LIBERROR_READ_OVERFLOW, "Value overflowed during integer read"); next_record (dtp, 1); ! return; } --- 614,620 ---- generate_error (&dtp->common, LIBERROR_READ_OVERFLOW, "Value overflowed during integer read"); next_record (dtp, 1); ! } *************** read_radix (st_parameter_dt *dtp, const *** 421,432 **** GFC_INTEGER_LARGEST v; int w, negative; char c, *p; ! w = f->u.w; ! p = read_block (dtp, &w); ! if (p == NULL) return; p = eat_leading_spaces (&w, p); if (w == 0) { --- 631,647 ---- GFC_INTEGER_LARGEST v; int w, negative; char c, *p; + size_t wu; ! wu = f->u.w; ! ! p = gfc_alloca (wu); ! ! if (read_block_form (dtp, p, &wu) == FAILURE) return; + w = wu; + p = eat_leading_spaces (&w, p); if (w == 0) { *************** read_radix (st_parameter_dt *dtp, const *** 550,556 **** generate_error (&dtp->common, LIBERROR_READ_OVERFLOW, "Value overflowed during integer read"); next_record (dtp, 1); ! return; } --- 765,771 ---- generate_error (&dtp->common, LIBERROR_READ_OVERFLOW, "Value overflowed during integer read"); next_record (dtp, 1); ! } *************** read_radix (st_parameter_dt *dtp, const *** 563,568 **** --- 778,784 ---- void read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length) { + size_t wu; int w, seen_dp, exponent; int exponent_sign, val_sign; int ndigits; *************** read_f (st_parameter_dt *dtp, const fnod *** 574,584 **** val_sign = 1; seen_dp = 0; ! w = f->u.w; ! p = read_block (dtp, &w); ! if (p == NULL) return; p = eat_leading_spaces (&w, p); if (w == 0) goto zero; --- 790,804 ---- val_sign = 1; seen_dp = 0; ! wu = f->u.w; ! ! p = gfc_alloca (wu); ! ! if (read_block_form (dtp, p, &wu) == FAILURE) return; + w = wu; + p = eat_leading_spaces (&w, p); if (w == 0) goto zero; *************** read_f (st_parameter_dt *dtp, const fnod *** 601,607 **** /* A digit, a '.' or a exponent character ('e', 'E', 'd' or 'D') is required at this point */ ! if (!isdigit (*p) && *p != '.' && *p != 'd' && *p != 'D' && *p != 'e' && *p != 'E') goto bad_float; --- 821,827 ---- /* A digit, a '.' or a exponent character ('e', 'E', 'd' or 'D') is required at this point */ ! if (!isdigit (*p) && *p != '.' && *p != ',' && *p != 'd' && *p != 'D' && *p != 'e' && *p != 'E') goto bad_float; *************** read_f (st_parameter_dt *dtp, const fnod *** 614,619 **** --- 834,846 ---- { switch (*p) { + case ',': + if (dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA + && *p == ',') + *p = '.'; + else + goto bad_float; + /* Fall through */ case '.': if (seen_dp) goto bad_float; *************** read_f (st_parameter_dt *dtp, const fnod *** 724,737 **** of the exponent in order to take account of the scale factor and the d parameter before explict conversion takes place. */ exp2: ! if (!isdigit (*p)) ! goto bad_float; ! ! exponent = *p - '0'; ! p++; ! w--; ! ! if (dtp->u.p.blank_status == BLANK_UNSPECIFIED) /* Normal processing of exponent */ { while (w > 0 && isdigit (*p)) { --- 951,959 ---- of the exponent in order to take account of the scale factor and the d parameter before explict conversion takes place. */ exp2: ! /* Normal processing of exponent */ ! exponent = 0; ! if (dtp->u.p.blank_status == BLANK_UNSPECIFIED) { while (w > 0 && isdigit (*p)) { *************** read_f (st_parameter_dt *dtp, const fnod *** 745,751 **** while (w > 0) { if (*p != ' ') ! goto bad_float; p++; w--; } --- 967,973 ---- while (w > 0) { if (*p != ' ') ! goto bad_float; p++; w--; } *************** read_f (st_parameter_dt *dtp, const fnod *** 836,842 **** if (buffer != scratch) free_mem (buffer); - return; } --- 1058,1063 ---- *************** read_f (st_parameter_dt *dtp, const fnod *** 844,862 **** * and never look at it. */ void ! read_x (st_parameter_dt *dtp, int n) { ! if (!is_stream_io (dtp)) ! { ! if ((dtp->u.p.current_unit->flags.pad == PAD_NO || is_internal_unit (dtp)) ! && dtp->u.p.current_unit->bytes_left < n) ! n = dtp->u.p.current_unit->bytes_left; ! dtp->u.p.sf_read_comma = 0; ! if (n > 0) ! read_sf (dtp, &n, 1); ! dtp->u.p.sf_read_comma = 1; ! } ! else ! dtp->u.p.current_unit->strm_pos += (gfc_offset) n; } --- 1065,1080 ---- * and never look at it. */ void ! read_x (st_parameter_dt * dtp, int n) { ! if ((dtp->u.p.current_unit->pad_status == PAD_NO || is_internal_unit (dtp)) ! && dtp->u.p.current_unit->bytes_left < n) ! n = dtp->u.p.current_unit->bytes_left; ! dtp->u.p.sf_read_comma = 0; ! if (n > 0) ! read_sf (dtp, &n, 1); ! dtp->u.p.sf_read_comma = 1; ! dtp->u.p.current_unit->strm_pos += (gfc_offset) n; } + diff -Nrcpad gcc-4.3.3/libgfortran/io/size_from_kind.c gcc-4.4.0/libgfortran/io/size_from_kind.c *** gcc-4.3.3/libgfortran/io/size_from_kind.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/io/size_from_kind.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** ! /* Copyright (C) 2005, 2007 Free Software Foundation, Inc. Contributed by Janne Blomqvist This file is part of the GNU Fortran runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with Libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ /* This file contains utility functions for determining the size of a --- 1,26 ---- ! /* Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Janne Blomqvist This file is part of the GNU Fortran runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ /* This file contains utility functions for determining the size of a diff -Nrcpad gcc-4.3.3/libgfortran/io/transfer.c gcc-4.4.0/libgfortran/io/transfer.c *** gcc-4.3.3/libgfortran/io/transfer.c Fri Mar 28 23:23:34 2008 --- gcc-4.4.0/libgfortran/io/transfer.c Thu Apr 9 23:23:07 2009 *************** *** 1,33 **** ! /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught Namelist transfer functions contributed by Paul Thomas This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with Libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ /* transfer.c -- Top level handling of data transfer statements. */ --- 1,29 ---- ! /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught Namelist transfer functions contributed by Paul Thomas + F2003 I/O support contributed by Jerry DeLisle This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ /* transfer.c -- Top level handling of data transfer statements. */ *************** Boston, MA 02110-1301, USA. */ *** 35,40 **** --- 31,37 ---- #include "io.h" #include #include + #include /* Calling conventions: Data transfer statements are unlike other *************** Boston, MA 02110-1301, USA. */ *** 52,57 **** --- 49,55 ---- transfer_integer transfer_logical transfer_character + transfer_character_wide transfer_real transfer_complex *************** export_proto(transfer_logical); *** 74,79 **** --- 72,80 ---- extern void transfer_character (st_parameter_dt *, void *, int); export_proto(transfer_character); + extern void transfer_character_wide (st_parameter_dt *, void *, int, int); + export_proto(transfer_character_wide); + extern void transfer_complex (st_parameter_dt *, void *, int); export_proto(transfer_complex); *************** static const st_option advance_opt[] = { *** 93,98 **** --- 94,132 ---- }; + static const st_option decimal_opt[] = { + {"point", DECIMAL_POINT}, + {"comma", DECIMAL_COMMA}, + {NULL, 0} + }; + + + static const st_option sign_opt[] = { + {"plus", SIGN_SP}, + {"suppress", SIGN_SS}, + {"processor_defined", SIGN_S}, + {NULL, 0} + }; + + static const st_option blank_opt[] = { + {"null", BLANK_NULL}, + {"zero", BLANK_ZERO}, + {NULL, 0} + }; + + static const st_option delim_opt[] = { + {"apostrophe", DELIM_APOSTROPHE}, + {"quote", DELIM_QUOTE}, + {"none", DELIM_NONE}, + {NULL, 0} + }; + + static const st_option pad_opt[] = { + {"yes", PAD_YES}, + {"no", PAD_NO}, + {NULL, 0} + }; + typedef enum { FORMATTED_SEQUENTIAL, UNFORMATTED_SEQUENTIAL, FORMATTED_DIRECT, UNFORMATTED_DIRECT, FORMATTED_STREAM, UNFORMATTED_STREAM *************** current_mode (st_parameter_dt *dtp) *** 146,154 **** char * read_sf (st_parameter_dt *dtp, int *length, int no_error) { ! char *base, *p, *q; ! int n, readlen, crlf; gfc_offset pos; if (*length > SCRATCH_SIZE) dtp->u.p.line_buffer = get_mem (*length); --- 180,189 ---- char * read_sf (st_parameter_dt *dtp, int *length, int no_error) { ! char *base, *p, q; ! int n, crlf; gfc_offset pos; + size_t readlen; if (*length > SCRATCH_SIZE) dtp->u.p.line_buffer = get_mem (*length); *************** read_sf (st_parameter_dt *dtp, int *leng *** 165,179 **** if (is_internal_unit (dtp)) { readlen = *length; ! q = salloc_r (dtp->u.p.current_unit->s, &readlen); ! if (readlen < *length) { generate_error (&dtp->common, LIBERROR_END, NULL); return NULL; } - if (q != NULL) - memcpy (p, q, readlen); goto done; } --- 200,212 ---- if (is_internal_unit (dtp)) { readlen = *length; ! if (unlikely (sread (dtp->u.p.current_unit->s, p, &readlen) != 0 ! || readlen < (size_t) *length)) { generate_error (&dtp->common, LIBERROR_END, NULL); return NULL; } goto done; } *************** read_sf (st_parameter_dt *dtp, int *leng *** 182,202 **** do { ! q = salloc_r (dtp->u.p.current_unit->s, &readlen); ! if (q == NULL) ! break; /* If we have a line without a terminating \n, drop through to EOR below. */ if (readlen < 1 && n == 0) { ! if (no_error) break; generate_error (&dtp->common, LIBERROR_END, NULL); return NULL; } ! if (readlen < 1 || *q == '\n' || *q == '\r') { /* Unexpected end of line. */ --- 215,237 ---- do { ! if (unlikely (sread (dtp->u.p.current_unit->s, &q, &readlen) != 0)) ! { ! generate_error (&dtp->common, LIBERROR_END, NULL); ! return NULL; ! } /* If we have a line without a terminating \n, drop through to EOR below. */ if (readlen < 1 && n == 0) { ! if (likely (no_error)) break; generate_error (&dtp->common, LIBERROR_END, NULL); return NULL; } ! if (readlen < 1 || q == '\n' || q == '\r') { /* Unexpected end of line. */ *************** read_sf (st_parameter_dt *dtp, int *leng *** 207,218 **** crlf = 0; /* If we encounter a CR, it might be a CRLF. */ ! if (*q == '\r') /* Probably a CRLF */ { readlen = 1; pos = stream_offset (dtp->u.p.current_unit->s); ! q = salloc_r (dtp->u.p.current_unit->s, &readlen); ! if (*q != '\n' && readlen == 1) /* Not a CRLF after all. */ sseek (dtp->u.p.current_unit->s, pos); else crlf = 1; --- 242,258 ---- crlf = 0; /* If we encounter a CR, it might be a CRLF. */ ! if (q == '\r') /* Probably a CRLF */ { readlen = 1; pos = stream_offset (dtp->u.p.current_unit->s); ! if (unlikely (sread (dtp->u.p.current_unit->s, &q, &readlen) ! != 0)) ! { ! generate_error (&dtp->common, LIBERROR_END, NULL); ! return NULL; ! } ! if (q != '\n' && readlen == 1) /* Not a CRLF after all. */ sseek (dtp->u.p.current_unit->s, pos); else crlf = 1; *************** read_sf (st_parameter_dt *dtp, int *leng *** 221,229 **** /* Without padding, terminate the I/O statement without assigning the value. With padding, the value still needs to be assigned, so we can just continue with a short read. */ ! if (dtp->u.p.current_unit->flags.pad == PAD_NO) { ! if (no_error) break; generate_error (&dtp->common, LIBERROR_EOR, NULL); return NULL; --- 261,269 ---- /* Without padding, terminate the I/O statement without assigning the value. With padding, the value still needs to be assigned, so we can just continue with a short read. */ ! if (dtp->u.p.current_unit->pad_status == PAD_NO) { ! if (likely (no_error)) break; generate_error (&dtp->common, LIBERROR_EOR, NULL); return NULL; *************** read_sf (st_parameter_dt *dtp, int *leng *** 236,242 **** /* Short circuit the read if a comma is found during numeric input. The flag is set to zero during character reads so that commas in strings are not ignored */ ! if (*q == ',') if (dtp->u.p.sf_read_comma == 1) { notify_std (&dtp->common, GFC_STD_GNU, --- 276,282 ---- /* Short circuit the read if a comma is found during numeric input. The flag is set to zero during character reads so that commas in strings are not ignored */ ! if (q == ',') if (dtp->u.p.sf_read_comma == 1) { notify_std (&dtp->common, GFC_STD_GNU, *************** read_sf (st_parameter_dt *dtp, int *leng *** 246,252 **** } n++; ! *p++ = *q; dtp->u.p.sf_seen_eor = 0; } while (n < *length); --- 286,292 ---- } n++; ! *p++ = q; dtp->u.p.sf_seen_eor = 0; } while (n < *length); *************** read_sf (st_parameter_dt *dtp, int *leng *** 255,320 **** dtp->u.p.current_unit->bytes_left -= *length; if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ! dtp->u.p.size_used += (gfc_offset) *length; return base; } /* Function for reading the next couple of bytes from the current ! file, advancing the current position. We return a pointer to a ! buffer containing the bytes. We return NULL on end of record or ! end of file. If the read is short, then it is because the current record does not have enough data to satisfy the read request and the file was opened with PAD=YES. The caller must assume tailing spaces for short reads. */ ! void * ! read_block (st_parameter_dt *dtp, int *length) { char *source; ! int nread; ! if (is_stream_io (dtp)) ! { ! if (dtp->u.p.current_unit->strm_pos - 1 ! != file_position (dtp->u.p.current_unit->s) ! && sseek (dtp->u.p.current_unit->s, ! dtp->u.p.current_unit->strm_pos - 1) == FAILURE) ! { ! generate_error (&dtp->common, LIBERROR_END, NULL); ! return NULL; ! } ! } ! else { ! if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *length) { /* For preconnected units with default record length, set bytes left to unit record length and proceed, otherwise error. */ if (dtp->u.p.current_unit->unit_number == options.stdin_unit && dtp->u.p.current_unit->recl == DEFAULT_RECL) ! dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; else { ! if (dtp->u.p.current_unit->flags.pad == PAD_NO) { /* Not enough data left. */ generate_error (&dtp->common, LIBERROR_EOR, NULL); ! return NULL; } } ! if (dtp->u.p.current_unit->bytes_left == 0) { dtp->u.p.current_unit->endfile = AT_ENDFILE; generate_error (&dtp->common, LIBERROR_END, NULL); ! return NULL; } ! *length = dtp->u.p.current_unit->bytes_left; } } --- 295,350 ---- dtp->u.p.current_unit->bytes_left -= *length; if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ! dtp->u.p.size_used += (GFC_IO_INT) *length; return base; } /* Function for reading the next couple of bytes from the current ! file, advancing the current position. We return FAILURE on end of record or ! end of file. This function is only for formatted I/O, unformatted uses ! read_block_direct. If the read is short, then it is because the current record does not have enough data to satisfy the read request and the file was opened with PAD=YES. The caller must assume tailing spaces for short reads. */ ! try ! read_block_form (st_parameter_dt *dtp, void *buf, size_t *nbytes) { char *source; ! size_t nread; ! int nb; ! if (!is_stream_io (dtp)) { ! if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes) { /* For preconnected units with default record length, set bytes left to unit record length and proceed, otherwise error. */ if (dtp->u.p.current_unit->unit_number == options.stdin_unit && dtp->u.p.current_unit->recl == DEFAULT_RECL) ! dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; else { ! if (unlikely (dtp->u.p.current_unit->pad_status == PAD_NO)) { /* Not enough data left. */ generate_error (&dtp->common, LIBERROR_EOR, NULL); ! return FAILURE; } } ! if (unlikely (dtp->u.p.current_unit->bytes_left == 0)) { dtp->u.p.current_unit->endfile = AT_ENDFILE; generate_error (&dtp->common, LIBERROR_END, NULL); ! return FAILURE; } ! *nbytes = dtp->u.p.current_unit->bytes_left; } } *************** read_block (st_parameter_dt *dtp, int *l *** 322,344 **** (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL || dtp->u.p.current_unit->flags.access == ACCESS_STREAM)) { ! source = read_sf (dtp, length, 0); dtp->u.p.current_unit->strm_pos += ! (gfc_offset) (*length + dtp->u.p.sf_seen_eor); ! return source; } ! dtp->u.p.current_unit->bytes_left -= (gfc_offset) *length; ! nread = *length; ! source = salloc_r (dtp->u.p.current_unit->s, &nread); if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ! dtp->u.p.size_used += (gfc_offset) nread; ! if (nread != *length) { /* Short read, this shouldn't happen. */ ! if (dtp->u.p.current_unit->flags.pad == PAD_YES) ! *length = nread; else { generate_error (&dtp->common, LIBERROR_EOR, NULL); --- 352,383 ---- (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL || dtp->u.p.current_unit->flags.access == ACCESS_STREAM)) { ! nb = *nbytes; ! source = read_sf (dtp, &nb, 0); ! *nbytes = nb; dtp->u.p.current_unit->strm_pos += ! (gfc_offset) (*nbytes + dtp->u.p.sf_seen_eor); ! if (source == NULL) ! return FAILURE; ! memcpy (buf, source, *nbytes); ! return SUCCESS; } ! dtp->u.p.current_unit->bytes_left -= (gfc_offset) *nbytes; ! nread = *nbytes; ! if (unlikely (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)) ! { ! generate_error (&dtp->common, LIBERROR_OS, NULL); ! return FAILURE; ! } if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ! dtp->u.p.size_used += (GFC_IO_INT) nread; ! if (nread != *nbytes) { /* Short read, this shouldn't happen. */ ! if (likely (dtp->u.p.current_unit->pad_status == PAD_YES)) ! *nbytes = nread; else { generate_error (&dtp->common, LIBERROR_EOR, NULL); *************** read_block (st_parameter_dt *dtp, int *l *** 348,354 **** dtp->u.p.current_unit->strm_pos += (gfc_offset) nread; ! return source; } --- 387,393 ---- dtp->u.p.current_unit->strm_pos += (gfc_offset) nread; ! return SUCCESS; } *************** read_block_direct (st_parameter_dt *dtp, *** 366,383 **** if (is_stream_io (dtp)) { - if (dtp->u.p.current_unit->strm_pos - 1 - != file_position (dtp->u.p.current_unit->s) - && sseek (dtp->u.p.current_unit->s, - dtp->u.p.current_unit->strm_pos - 1) == FAILURE) - { - generate_error (&dtp->common, LIBERROR_END, NULL); - return; - } - to_read_record = *nbytes; have_read_record = to_read_record; ! if (sread (dtp->u.p.current_unit->s, buf, &have_read_record) != 0) { generate_error (&dtp->common, LIBERROR_OS, NULL); return; --- 405,414 ---- if (is_stream_io (dtp)) { to_read_record = *nbytes; have_read_record = to_read_record; ! if (unlikely (sread (dtp->u.p.current_unit->s, buf, &have_read_record) ! != 0)) { generate_error (&dtp->common, LIBERROR_OS, NULL); return; *************** read_block_direct (st_parameter_dt *dtp, *** 385,391 **** dtp->u.p.current_unit->strm_pos += (gfc_offset) have_read_record; ! if (to_read_record != have_read_record) { /* Short read, e.g. if we hit EOF. For stream files, we have to set the end-of-file condition. */ --- 416,422 ---- dtp->u.p.current_unit->strm_pos += (gfc_offset) have_read_record; ! if (unlikely (to_read_record != have_read_record)) { /* Short read, e.g. if we hit EOF. For stream files, we have to set the end-of-file condition. */ *************** read_block_direct (st_parameter_dt *dtp, *** 412,418 **** dtp->u.p.current_unit->bytes_left -= to_read_record; ! if (sread (dtp->u.p.current_unit->s, buf, &to_read_record) != 0) { generate_error (&dtp->common, LIBERROR_OS, NULL); return; --- 443,450 ---- dtp->u.p.current_unit->bytes_left -= to_read_record; ! if (unlikely (sread (dtp->u.p.current_unit->s, buf, &to_read_record) ! != 0)) { generate_error (&dtp->common, LIBERROR_OS, NULL); return; *************** read_block_direct (st_parameter_dt *dtp, *** 426,432 **** return; } ! if (short_record) { generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL); return; --- 458,464 ---- return; } ! if (unlikely (short_record)) { generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL); return; *************** read_block_direct (st_parameter_dt *dtp, *** 438,444 **** until the request has been fulfilled or the record has run out of continuation subrecords. */ ! if (dtp->u.p.current_unit->endfile == AT_ENDFILE) { generate_error (&dtp->common, LIBERROR_END, NULL); return; --- 470,476 ---- until the request has been fulfilled or the record has run out of continuation subrecords. */ ! if (unlikely (dtp->u.p.current_unit->endfile == AT_ENDFILE)) { generate_error (&dtp->common, LIBERROR_END, NULL); return; *************** read_block_direct (st_parameter_dt *dtp, *** 476,483 **** dtp->u.p.current_unit->bytes_left_subrecord -= to_read_subrecord; have_read_subrecord = to_read_subrecord; ! if (sread (dtp->u.p.current_unit->s, buf + have_read_record, ! &have_read_subrecord) != 0) { generate_error (&dtp->common, LIBERROR_OS, NULL); return; --- 508,515 ---- dtp->u.p.current_unit->bytes_left_subrecord -= to_read_subrecord; have_read_subrecord = to_read_subrecord; ! if (unlikely (sread (dtp->u.p.current_unit->s, buf + have_read_record, ! &have_read_subrecord) != 0)) { generate_error (&dtp->common, LIBERROR_OS, NULL); return; *************** read_block_direct (st_parameter_dt *dtp, *** 485,491 **** have_read_record += have_read_subrecord; ! if (to_read_subrecord != have_read_subrecord) { /* Short read, e.g. if we hit EOF. This means the record --- 517,523 ---- have_read_record += have_read_subrecord; ! if (unlikely (to_read_subrecord != have_read_subrecord)) { /* Short read, e.g. if we hit EOF. This means the record *************** read_block_direct (st_parameter_dt *dtp, *** 499,505 **** if (to_read_record > 0) { ! if (dtp->u.p.current_unit->continued) { next_record_r_unf (dtp, 0); us_read (dtp, 1); --- 531,537 ---- if (to_read_record > 0) { ! if (likely (dtp->u.p.current_unit->continued)) { next_record_r_unf (dtp, 0); us_read (dtp, 1); *************** read_block_direct (st_parameter_dt *dtp, *** 523,529 **** } dtp->u.p.current_unit->bytes_left -= have_read_record; ! if (short_record) { generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL); return; --- 555,561 ---- } dtp->u.p.current_unit->bytes_left -= have_read_record; ! if (unlikely (short_record)) { generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL); return; *************** write_block (st_parameter_dt *dtp, int l *** 542,567 **** { char *dest; ! if (is_stream_io (dtp)) ! { ! if (dtp->u.p.current_unit->strm_pos - 1 ! != file_position (dtp->u.p.current_unit->s) ! && sseek (dtp->u.p.current_unit->s, ! dtp->u.p.current_unit->strm_pos - 1) == FAILURE) ! { ! generate_error (&dtp->common, LIBERROR_OS, NULL); ! return NULL; ! } ! } ! else { if (dtp->u.p.current_unit->bytes_left < (gfc_offset) length) { /* For preconnected units with default record length, set bytes left to unit record length and proceed, otherwise error. */ ! if ((dtp->u.p.current_unit->unit_number == options.stdout_unit ! || dtp->u.p.current_unit->unit_number == options.stderr_unit) ! && dtp->u.p.current_unit->recl == DEFAULT_RECL) dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; else { --- 574,590 ---- { char *dest; ! if (!is_stream_io (dtp)) { if (dtp->u.p.current_unit->bytes_left < (gfc_offset) length) { /* For preconnected units with default record length, set bytes left to unit record length and proceed, otherwise error. */ ! if (likely ((dtp->u.p.current_unit->unit_number ! == options.stdout_unit ! || dtp->u.p.current_unit->unit_number ! == options.stderr_unit) ! && dtp->u.p.current_unit->recl == DEFAULT_RECL)) dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; else { *************** write_block (st_parameter_dt *dtp, int l *** 573,591 **** dtp->u.p.current_unit->bytes_left -= (gfc_offset) length; } ! dest = salloc_w (dtp->u.p.current_unit->s, &length); ! ! if (dest == NULL) { ! generate_error (&dtp->common, LIBERROR_END, NULL); ! return NULL; ! } ! if (is_internal_unit (dtp) && dtp->u.p.current_unit->endfile == AT_ENDFILE) ! generate_error (&dtp->common, LIBERROR_END, NULL); if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ! dtp->u.p.size_used += (gfc_offset) length; dtp->u.p.current_unit->strm_pos += (gfc_offset) length; --- 596,626 ---- dtp->u.p.current_unit->bytes_left -= (gfc_offset) length; } ! if (is_internal_unit (dtp)) { ! dest = salloc_w (dtp->u.p.current_unit->s, &length); ! if (dest == NULL) ! { ! generate_error (&dtp->common, LIBERROR_END, NULL); ! return NULL; ! } + if (unlikely (dtp->u.p.current_unit->endfile == AT_ENDFILE)) + generate_error (&dtp->common, LIBERROR_END, NULL); + } + else + { + dest = fbuf_alloc (dtp->u.p.current_unit, length); + if (dest == NULL) + { + generate_error (&dtp->common, LIBERROR_OS, NULL); + return NULL; + } + } + if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ! dtp->u.p.size_used += (GFC_IO_INT) length; dtp->u.p.current_unit->strm_pos += (gfc_offset) length; *************** write_buf (st_parameter_dt *dtp, void *b *** 608,623 **** if (is_stream_io (dtp)) { ! if (dtp->u.p.current_unit->strm_pos - 1 ! != file_position (dtp->u.p.current_unit->s) ! && sseek (dtp->u.p.current_unit->s, ! dtp->u.p.current_unit->strm_pos - 1) == FAILURE) ! { ! generate_error (&dtp->common, LIBERROR_OS, NULL); ! return FAILURE; ! } ! ! if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0) { generate_error (&dtp->common, LIBERROR_OS, NULL); return FAILURE; --- 643,649 ---- if (is_stream_io (dtp)) { ! if (unlikely (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)) { generate_error (&dtp->common, LIBERROR_OS, NULL); return FAILURE; *************** write_buf (st_parameter_dt *dtp, void *b *** 632,647 **** if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) { ! if (dtp->u.p.current_unit->bytes_left < (gfc_offset) nbytes) { generate_error (&dtp->common, LIBERROR_DIRECT_EOR, NULL); return FAILURE; } if (buf == NULL && nbytes == 0) ! return SUCCESS; ! if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0) { generate_error (&dtp->common, LIBERROR_OS, NULL); return FAILURE; --- 658,673 ---- if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) { ! if (unlikely (dtp->u.p.current_unit->bytes_left < (gfc_offset) nbytes)) { generate_error (&dtp->common, LIBERROR_DIRECT_EOR, NULL); return FAILURE; } if (buf == NULL && nbytes == 0) ! return SUCCESS; ! if (unlikely (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)) { generate_error (&dtp->common, LIBERROR_OS, NULL); return FAILURE; *************** write_buf (st_parameter_dt *dtp, void *b *** 678,685 **** dtp->u.p.current_unit->bytes_left_subrecord -= (gfc_offset) to_write_subrecord; ! if (swrite (dtp->u.p.current_unit->s, buf + have_written, ! &to_write_subrecord) != 0) { generate_error (&dtp->common, LIBERROR_OS, NULL); return FAILURE; --- 704,711 ---- dtp->u.p.current_unit->bytes_left_subrecord -= (gfc_offset) to_write_subrecord; ! if (unlikely (swrite (dtp->u.p.current_unit->s, buf + have_written, ! &to_write_subrecord) != 0)) { generate_error (&dtp->common, LIBERROR_OS, NULL); return FAILURE; *************** write_buf (st_parameter_dt *dtp, void *b *** 696,702 **** us_write (dtp, 1); } dtp->u.p.current_unit->bytes_left -= have_written; ! if (short_record) { generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL); return FAILURE; --- 722,728 ---- us_write (dtp, 1); } dtp->u.p.current_unit->bytes_left -= have_written; ! if (unlikely (short_record)) { generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL); return FAILURE; *************** write_buf (st_parameter_dt *dtp, void *b *** 709,743 **** static void unformatted_read (st_parameter_dt *dtp, bt type, ! void *dest, int kind __attribute__((unused)), ! size_t size, size_t nelems) { size_t i, sz; ! /* Currently, character implies size=1. */ ! if (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE ! || size == 1 || type == BT_CHARACTER) { sz = size * nelems; read_block_direct (dtp, dest, &sz); } else { char buffer[16]; char *p; ! /* Break up complex into its constituent reals. */ if (type == BT_COMPLEX) { nelems *= 2; size /= 2; } - p = dest; /* By now, all complex variables have been split into their constituent reals. */ ! for (i=0; iu.p.current_unit->flags.convert == GFC_CONVERT_NATIVE) ! || kind == 1) { sz = size * nelems; + if (type == BT_CHARACTER) + sz *= GFC_SIZE_OF_CHAR_KIND(kind); read_block_direct (dtp, dest, &sz); } else { char buffer[16]; char *p; ! ! p = dest; ! ! /* Handle wide chracters. */ ! if (type == BT_CHARACTER && kind != 1) ! { ! nelems *= size; ! size = kind; ! } ! /* Break up complex into its constituent reals. */ if (type == BT_COMPLEX) { nelems *= 2; size /= 2; } /* By now, all complex variables have been split into their constituent reals. */ ! for (i = 0; i < nelems; i++) { read_block_direct (dtp, buffer, &size); reverse_memcpy (p, buffer, size); *************** unformatted_read (st_parameter_dt *dtp, *** 754,773 **** static void unformatted_write (st_parameter_dt *dtp, bt type, ! void *source, int kind __attribute__((unused)), ! size_t size, size_t nelems) { ! if (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE || ! size == 1 || type == BT_CHARACTER) { ! size *= nelems; ! write_buf (dtp, source, size); } else { char buffer[16]; char *p; size_t i; /* Break up complex into its constituent reals. */ if (type == BT_COMPLEX) --- 788,817 ---- static void unformatted_write (st_parameter_dt *dtp, bt type, ! void *source, int kind, size_t size, size_t nelems) { ! if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE) ! || kind == 1) { ! size_t stride = type == BT_CHARACTER ? ! size * GFC_SIZE_OF_CHAR_KIND(kind) : size; ! ! write_buf (dtp, source, stride * nelems); } else { char buffer[16]; char *p; size_t i; + + p = source; + + /* Handle wide chracters. */ + if (type == BT_CHARACTER && kind != 1) + { + nelems *= size; + size = kind; + } /* Break up complex into its constituent reals. */ if (type == BT_COMPLEX) *************** unformatted_write (st_parameter_dt *dtp, *** 776,791 **** size /= 2; } - p = source; - /* By now, all complex variables have been split into their constituent reals. */ ! ! for (i=0; iu.string.length; if (length == 0) --- 873,879 ---- write_constant_string (st_parameter_dt *dtp, const fnode *f) { char c, delimiter, *p, *q; ! int length; length = f->u.string.length; if (length == 0) *************** write_constant_string (st_parameter_dt * *** 841,847 **** p = write_block (dtp, length); if (p == NULL) return; ! q = f->u.string.p; delimiter = q[-1]; --- 882,888 ---- p = write_block (dtp, length); if (p == NULL) return; ! q = f->u.string.p; delimiter = q[-1]; *************** require_type (st_parameter_dt *dtp, bt e *** 883,889 **** of the next element, then comes back here to process it. */ static void ! formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int len, size_t size) { char scratch[SCRATCH_SIZE]; --- 924,930 ---- of the next element, then comes back here to process it. */ static void ! formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, size_t size) { char scratch[SCRATCH_SIZE]; *************** formatted_transfer_scalar (st_parameter_ *** 910,918 **** /* Set this flag so that commas in reads cause the read to complete before the entire field has been read. The next read field will start right after the comma in the stream. (Set to 0 for character reads). */ ! dtp->u.p.sf_read_comma = 1; dtp->u.p.line_buffer = scratch; for (;;) { /* If reversion has occurred and there is another real data item, --- 951,961 ---- /* Set this flag so that commas in reads cause the read to complete before the entire field has been read. The next read field will start right after the comma in the stream. (Set to 0 for character reads). */ ! dtp->u.p.sf_read_comma = ! dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA ? 0 : 1; dtp->u.p.line_buffer = scratch; + for (;;) { /* If reversion has occurred and there is another real data item, *************** formatted_transfer_scalar (st_parameter_ *** 923,929 **** next_record (dtp, 0); } ! consume_data_flag = 1 ; if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) break; --- 966,972 ---- next_record (dtp, 0); } ! consume_data_flag = 1; if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) break; *************** formatted_transfer_scalar (st_parameter_ *** 931,937 **** if (f == NULL) { /* No data descriptors left. */ ! if (n > 0) generate_error (&dtp->common, LIBERROR_FORMAT, "Insufficient data descriptors in format after reversion"); return; --- 974,980 ---- if (f == NULL) { /* No data descriptors left. */ ! if (unlikely (n > 0)) generate_error (&dtp->common, LIBERROR_FORMAT, "Insufficient data descriptors in format after reversion"); return; *************** formatted_transfer_scalar (st_parameter_ *** 959,965 **** } if (dtp->u.p.skips < 0) { ! move_pos_offset (dtp->u.p.current_unit->s, dtp->u.p.skips); dtp->u.p.current_unit->bytes_left -= (gfc_offset) dtp->u.p.skips; } dtp->u.p.skips = dtp->u.p.pending_spaces = 0; --- 1002,1011 ---- } if (dtp->u.p.skips < 0) { ! if (is_internal_unit (dtp)) ! move_pos_offset (dtp->u.p.current_unit->s, dtp->u.p.skips); ! else ! fbuf_seek (dtp->u.p.current_unit, dtp->u.p.skips); dtp->u.p.current_unit->bytes_left -= (gfc_offset) dtp->u.p.skips; } dtp->u.p.skips = dtp->u.p.pending_spaces = 0; *************** formatted_transfer_scalar (st_parameter_ *** 980,988 **** return; if (dtp->u.p.mode == READING) ! read_decimal (dtp, f, p, len); else ! write_i (dtp, f, p, len); break; --- 1026,1034 ---- return; if (dtp->u.p.mode == READING) ! read_decimal (dtp, f, p, kind); else ! write_i (dtp, f, p, kind); break; *************** formatted_transfer_scalar (st_parameter_ *** 995,1003 **** return; if (dtp->u.p.mode == READING) ! read_radix (dtp, f, p, len, 2); else ! write_b (dtp, f, p, len); break; --- 1041,1049 ---- return; if (dtp->u.p.mode == READING) ! read_radix (dtp, f, p, kind, 2); else ! write_b (dtp, f, p, kind); break; *************** formatted_transfer_scalar (st_parameter_ *** 1010,1018 **** return; if (dtp->u.p.mode == READING) ! read_radix (dtp, f, p, len, 8); else ! write_o (dtp, f, p, len); break; --- 1056,1064 ---- return; if (dtp->u.p.mode == READING) ! read_radix (dtp, f, p, kind, 8); else ! write_o (dtp, f, p, kind); break; *************** formatted_transfer_scalar (st_parameter_ *** 1025,1033 **** return; if (dtp->u.p.mode == READING) ! read_radix (dtp, f, p, len, 16); else ! write_z (dtp, f, p, len); break; --- 1071,1079 ---- return; if (dtp->u.p.mode == READING) ! read_radix (dtp, f, p, kind, 16); else ! write_z (dtp, f, p, kind); break; *************** formatted_transfer_scalar (st_parameter_ *** 1035,1045 **** if (n == 0) goto need_data; if (dtp->u.p.mode == READING) ! read_a (dtp, f, p, len); else ! write_a (dtp, f, p, len); ! break; case FMT_L: --- 1081,1103 ---- if (n == 0) goto need_data; + /* It is possible to have FMT_A with something not BT_CHARACTER such + as when writing out hollerith strings, so check both type + and kind before calling wide character routines. */ if (dtp->u.p.mode == READING) ! { ! if (type == BT_CHARACTER && kind == 4) ! read_a_char4 (dtp, f, p, size); ! else ! read_a (dtp, f, p, size); ! } else ! { ! if (type == BT_CHARACTER && kind == 4) ! write_a_char4 (dtp, f, p, size); ! else ! write_a (dtp, f, p, size); ! } break; case FMT_L: *************** formatted_transfer_scalar (st_parameter_ *** 1047,1055 **** goto need_data; if (dtp->u.p.mode == READING) ! read_l (dtp, f, p, len); else ! write_l (dtp, f, p, len); break; --- 1105,1113 ---- goto need_data; if (dtp->u.p.mode == READING) ! read_l (dtp, f, p, kind); else ! write_l (dtp, f, p, kind); break; *************** formatted_transfer_scalar (st_parameter_ *** 1060,1068 **** return; if (dtp->u.p.mode == READING) ! read_f (dtp, f, p, len); else ! write_d (dtp, f, p, len); break; --- 1118,1126 ---- return; if (dtp->u.p.mode == READING) ! read_f (dtp, f, p, kind); else ! write_d (dtp, f, p, kind); break; *************** formatted_transfer_scalar (st_parameter_ *** 1073,1081 **** return; if (dtp->u.p.mode == READING) ! read_f (dtp, f, p, len); else ! write_e (dtp, f, p, len); break; case FMT_EN: --- 1131,1139 ---- return; if (dtp->u.p.mode == READING) ! read_f (dtp, f, p, kind); else ! write_e (dtp, f, p, kind); break; case FMT_EN: *************** formatted_transfer_scalar (st_parameter_ *** 1085,1093 **** return; if (dtp->u.p.mode == READING) ! read_f (dtp, f, p, len); else ! write_en (dtp, f, p, len); break; --- 1143,1151 ---- return; if (dtp->u.p.mode == READING) ! read_f (dtp, f, p, kind); else ! write_en (dtp, f, p, kind); break; *************** formatted_transfer_scalar (st_parameter_ *** 1098,1106 **** return; if (dtp->u.p.mode == READING) ! read_f (dtp, f, p, len); else ! write_es (dtp, f, p, len); break; --- 1156,1164 ---- return; if (dtp->u.p.mode == READING) ! read_f (dtp, f, p, kind); else ! write_es (dtp, f, p, kind); break; *************** formatted_transfer_scalar (st_parameter_ *** 1111,1119 **** return; if (dtp->u.p.mode == READING) ! read_f (dtp, f, p, len); else ! write_f (dtp, f, p, len); break; --- 1169,1177 ---- return; if (dtp->u.p.mode == READING) ! read_f (dtp, f, p, kind); else ! write_f (dtp, f, p, kind); break; *************** formatted_transfer_scalar (st_parameter_ *** 1124,1139 **** switch (type) { case BT_INTEGER: ! read_decimal (dtp, f, p, len); break; case BT_LOGICAL: ! read_l (dtp, f, p, len); break; case BT_CHARACTER: ! read_a (dtp, f, p, len); break; case BT_REAL: ! read_f (dtp, f, p, len); break; default: goto bad_type; --- 1182,1200 ---- switch (type) { case BT_INTEGER: ! read_decimal (dtp, f, p, kind); break; case BT_LOGICAL: ! read_l (dtp, f, p, kind); break; case BT_CHARACTER: ! if (kind == 4) ! read_a_char4 (dtp, f, p, size); ! else ! read_a (dtp, f, p, size); break; case BT_REAL: ! read_f (dtp, f, p, kind); break; default: goto bad_type; *************** formatted_transfer_scalar (st_parameter_ *** 1142,1157 **** switch (type) { case BT_INTEGER: ! write_i (dtp, f, p, len); break; case BT_LOGICAL: ! write_l (dtp, f, p, len); break; case BT_CHARACTER: ! write_a (dtp, f, p, len); break; case BT_REAL: ! write_d (dtp, f, p, len); break; default: bad_type: --- 1203,1224 ---- switch (type) { case BT_INTEGER: ! write_i (dtp, f, p, kind); break; case BT_LOGICAL: ! write_l (dtp, f, p, kind); break; case BT_CHARACTER: ! if (kind == 4) ! write_a_char4 (dtp, f, p, size); ! else ! write_a (dtp, f, p, size); break; case BT_REAL: ! if (f->u.real.w == 0) ! write_real_g0 (dtp, p, kind, f->u.real.d); ! else ! write_d (dtp, f, p, kind); break; default: bad_type: *************** formatted_transfer_scalar (st_parameter_ *** 1162,1168 **** break; case FMT_STRING: ! consume_data_flag = 0 ; if (dtp->u.p.mode == READING) { format_error (dtp, f, "Constant string in input format"); --- 1229,1235 ---- break; case FMT_STRING: ! consume_data_flag = 0; if (dtp->u.p.mode == READING) { format_error (dtp, f, "Constant string in input format"); *************** formatted_transfer_scalar (st_parameter_ *** 1273,1289 **** break; case FMT_S: ! consume_data_flag = 0 ; dtp->u.p.sign_status = SIGN_S; break; case FMT_SS: ! consume_data_flag = 0 ; dtp->u.p.sign_status = SIGN_SS; break; case FMT_SP: ! consume_data_flag = 0 ; dtp->u.p.sign_status = SIGN_SP; break; --- 1340,1356 ---- break; case FMT_S: ! consume_data_flag = 0; dtp->u.p.sign_status = SIGN_S; break; case FMT_SS: ! consume_data_flag = 0; dtp->u.p.sign_status = SIGN_SS; break; case FMT_SP: ! consume_data_flag = 0; dtp->u.p.sign_status = SIGN_SP; break; *************** formatted_transfer_scalar (st_parameter_ *** 1293,1314 **** break; case FMT_BZ: ! consume_data_flag = 0 ; dtp->u.p.blank_status = BLANK_ZERO; break; case FMT_P: ! consume_data_flag = 0 ; dtp->u.p.scale_factor = f->u.k; break; case FMT_DOLLAR: ! consume_data_flag = 0 ; dtp->u.p.seen_dollar = 1; break; case FMT_SLASH: ! consume_data_flag = 0 ; dtp->u.p.skips = dtp->u.p.pending_spaces = 0; next_record (dtp, 0); break; --- 1360,1391 ---- break; case FMT_BZ: ! consume_data_flag = 0; dtp->u.p.blank_status = BLANK_ZERO; break; + case FMT_DC: + consume_data_flag = 0; + dtp->u.p.current_unit->decimal_status = DECIMAL_COMMA; + break; + + case FMT_DP: + consume_data_flag = 0; + dtp->u.p.current_unit->decimal_status = DECIMAL_POINT; + break; + case FMT_P: ! consume_data_flag = 0; dtp->u.p.scale_factor = f->u.k; break; case FMT_DOLLAR: ! consume_data_flag = 0; dtp->u.p.seen_dollar = 1; break; case FMT_SLASH: ! consume_data_flag = 0; dtp->u.p.skips = dtp->u.p.pending_spaces = 0; next_record (dtp, 0); break; *************** formatted_transfer_scalar (st_parameter_ *** 1318,1324 **** particular preventing another / descriptor from being processed) unless there is another data item to be transferred. */ ! consume_data_flag = 0 ; if (n == 0) return; break; --- 1395,1401 ---- particular preventing another / descriptor from being processed) unless there is another data item to be transferred. */ ! consume_data_flag = 0; if (n == 0) return; break; *************** formatted_transfer (st_parameter_dt *dtp *** 1370,1381 **** char *tmp; tmp = (char *) p; ! /* Big loop over all the elements. */ for (elem = 0; elem < nelems; elem++) { dtp->u.p.item_count++; ! formatted_transfer_scalar (dtp, type, tmp + size*elem, kind, size); } } --- 1447,1459 ---- char *tmp; tmp = (char *) p; ! size_t stride = type == BT_CHARACTER ? ! size * GFC_SIZE_OF_CHAR_KIND(kind) : size; /* Big loop over all the elements. */ for (elem = 0; elem < nelems; elem++) { dtp->u.p.item_count++; ! formatted_transfer_scalar (dtp, type, tmp + stride*elem, kind, size); } } *************** transfer_character (st_parameter_dt *dtp *** 1428,1437 **** if (len == 0 && p == NULL) p = empty_string; ! /* Currently we support only 1 byte chars, and the library is a bit ! confused of character kind vs. length, so we kludge it by setting ! kind = length. */ ! dtp->u.p.transfer (dtp, BT_CHARACTER, p, len, len, 1); } --- 1506,1531 ---- if (len == 0 && p == NULL) p = empty_string; ! /* Set kind here to 1. */ ! dtp->u.p.transfer (dtp, BT_CHARACTER, p, 1, len, 1); ! } ! ! void ! transfer_character_wide (st_parameter_dt *dtp, void *p, int len, int kind) ! { ! static char *empty_string[0]; ! ! if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) ! return; ! ! /* Strings of zero length can have p == NULL, which confuses the ! transfer routines into thinking we need more data elements. To avoid ! this, we give them a nice pointer. */ ! if (len == 0 && p == NULL) ! p = empty_string; ! ! /* Here we pass the actual kind value. */ ! dtp->u.p.transfer (dtp, BT_CHARACTER, p, kind, len, 1); } *************** transfer_array (st_parameter_dt *dtp, gf *** 1485,1497 **** break; case GFC_DTYPE_CHARACTER: iotype = BT_CHARACTER; - /* FIXME: Currently dtype contains the charlen, which is - clobbered if charlen > 2**24. That's why we use a separate - argument for the charlen. However, if we want to support - non-8-bit charsets we need to fix dtype to contain - sizeof(chartype) and fix the code below. */ size = charlen; - kind = charlen; break; case GFC_DTYPE_DERIVED: internal_error (&dtp->common, --- 1579,1585 ---- *************** transfer_array (st_parameter_dt *dtp, gf *** 1505,1511 **** for (n = 0; n < rank; n++) { count[n] = 0; ! stride[n] = desc->dim[n].stride; extent[n] = desc->dim[n].ubound + 1 - desc->dim[n].lbound; /* If the extent of even one dimension is zero, then the entire --- 1593,1601 ---- for (n = 0; n < rank; n++) { count[n] = 0; ! stride[n] = iotype == BT_CHARACTER ? ! desc->dim[n].stride * GFC_SIZE_OF_CHAR_KIND(kind) : ! desc->dim[n].stride; extent[n] = desc->dim[n].ubound + 1 - desc->dim[n].lbound; /* If the extent of even one dimension is zero, then the entire *************** transfer_array (st_parameter_dt *dtp, gf *** 1562,1570 **** static void us_read (st_parameter_dt *dtp, int continued) { ! char *p; ! int n; ! int nr; GFC_INTEGER_4 i4; GFC_INTEGER_8 i8; gfc_offset i; --- 1652,1658 ---- static void us_read (st_parameter_dt *dtp, int continued) { ! size_t n, nr; GFC_INTEGER_4 i4; GFC_INTEGER_8 i8; gfc_offset i; *************** us_read (st_parameter_dt *dtp, int conti *** 1579,1585 **** nr = n; ! p = salloc_r (dtp->u.p.current_unit->s, &n); if (n == 0) { --- 1667,1677 ---- nr = n; ! if (unlikely (sread (dtp->u.p.current_unit->s, &i, &n) != 0)) ! { ! generate_error (&dtp->common, LIBERROR_BAD_US, NULL); ! return; ! } if (n == 0) { *************** us_read (st_parameter_dt *dtp, int conti *** 1587,1610 **** return; /* end of file */ } ! if (p == NULL || n != nr) { generate_error (&dtp->common, LIBERROR_BAD_US, NULL); return; } /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */ ! if (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE) { switch (nr) { case sizeof(GFC_INTEGER_4): ! memcpy (&i4, p, sizeof (i4)); i = i4; break; case sizeof(GFC_INTEGER_8): ! memcpy (&i8, p, sizeof (i8)); i = i8; break; --- 1679,1702 ---- return; /* end of file */ } ! if (unlikely (n != nr)) { generate_error (&dtp->common, LIBERROR_BAD_US, NULL); return; } /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */ ! if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE)) { switch (nr) { case sizeof(GFC_INTEGER_4): ! memcpy (&i4, &i, sizeof (i4)); i = i4; break; case sizeof(GFC_INTEGER_8): ! memcpy (&i8, &i, sizeof (i8)); i = i8; break; *************** us_read (st_parameter_dt *dtp, int conti *** 1617,1628 **** switch (nr) { case sizeof(GFC_INTEGER_4): ! reverse_memcpy (&i4, p, sizeof (i4)); i = i4; break; case sizeof(GFC_INTEGER_8): ! reverse_memcpy (&i8, p, sizeof (i8)); i = i8; break; --- 1709,1720 ---- switch (nr) { case sizeof(GFC_INTEGER_4): ! reverse_memcpy (&i4, &i, sizeof (i4)); i = i4; break; case sizeof(GFC_INTEGER_8): ! reverse_memcpy (&i8, &i, sizeof (i8)); i = i8; break; *************** pre_position (st_parameter_dt *dtp) *** 1690,1699 **** { case FORMATTED_STREAM: case UNFORMATTED_STREAM: ! /* There are no records with stream I/O. Set the default position ! to the beginning of the file if no position was specified. */ ! if ((dtp->common.flags & IOPARM_DT_HAS_REC) == 0) ! dtp->u.p.current_unit->strm_pos = 1; break; case UNFORMATTED_SEQUENTIAL: --- 1782,1791 ---- { case FORMATTED_STREAM: case UNFORMATTED_STREAM: ! /* There are no records with stream I/O. If the position was specified ! data_transfer_init has already positioned the file. If no position ! was specified, we continue from where we last left off. I.e. ! there is nothing to do here. */ break; case UNFORMATTED_SEQUENTIAL: *************** data_transfer_init (st_parameter_dt *dtp *** 1726,1732 **** --- 1818,1826 ---- namelist_info *ionml; ionml = ((cf & IOPARM_DT_IONML_SET) != 0) ? dtp->u.p.ionml : NULL; + memset (&dtp->u.p, 0, sizeof (dtp->u.p)); + dtp->u.p.ionml = ionml; dtp->u.p.mode = read_flag ? READING : WRITING; *************** data_transfer_init (st_parameter_dt *dtp *** 1742,1796 **** st_parameter_open opp; unit_convert conv; ! if (dtp->common.unit < 0) ! { ! close_unit (dtp->u.p.current_unit); ! dtp->u.p.current_unit = NULL; ! generate_error (&dtp->common, LIBERROR_BAD_OPTION, ! "Bad unit number in OPEN statement"); ! return; ! } ! memset (&u_flags, '\0', sizeof (u_flags)); ! u_flags.access = ACCESS_SEQUENTIAL; ! u_flags.action = ACTION_READWRITE; ! /* Is it unformatted? */ ! if (!(cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT ! | IOPARM_DT_IONML_SET))) ! u_flags.form = FORM_UNFORMATTED; ! else ! u_flags.form = FORM_UNSPECIFIED; ! u_flags.delim = DELIM_UNSPECIFIED; ! u_flags.blank = BLANK_UNSPECIFIED; ! u_flags.pad = PAD_UNSPECIFIED; ! u_flags.status = STATUS_UNKNOWN; ! conv = get_unformatted_convert (dtp->common.unit); ! if (conv == GFC_CONVERT_NONE) ! conv = compile_options.convert; ! /* We use l8_to_l4_offset, which is 0 on little-endian machines ! and 1 on big-endian machines. */ ! switch (conv) ! { ! case GFC_CONVERT_NATIVE: ! case GFC_CONVERT_SWAP: ! break; ! case GFC_CONVERT_BIG: ! conv = l8_to_l4_offset ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP; ! break; ! case GFC_CONVERT_LITTLE: ! conv = l8_to_l4_offset ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE; ! break; ! default: ! internal_error (&opp.common, "Illegal value for CONVERT"); ! break; ! } u_flags.convert = conv; --- 1836,1896 ---- st_parameter_open opp; unit_convert conv; ! if (dtp->common.unit < 0) ! { ! close_unit (dtp->u.p.current_unit); ! dtp->u.p.current_unit = NULL; ! generate_error (&dtp->common, LIBERROR_BAD_OPTION, ! "Bad unit number in OPEN statement"); ! return; ! } ! memset (&u_flags, '\0', sizeof (u_flags)); ! u_flags.access = ACCESS_SEQUENTIAL; ! u_flags.action = ACTION_READWRITE; ! /* Is it unformatted? */ ! if (!(cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT ! | IOPARM_DT_IONML_SET))) ! u_flags.form = FORM_UNFORMATTED; ! else ! u_flags.form = FORM_UNSPECIFIED; ! u_flags.delim = DELIM_UNSPECIFIED; ! u_flags.blank = BLANK_UNSPECIFIED; ! u_flags.pad = PAD_UNSPECIFIED; ! u_flags.decimal = DECIMAL_UNSPECIFIED; ! u_flags.encoding = ENCODING_UNSPECIFIED; ! u_flags.async = ASYNC_UNSPECIFIED; ! u_flags.round = ROUND_UNSPECIFIED; ! u_flags.sign = SIGN_UNSPECIFIED; ! u_flags.status = STATUS_UNKNOWN; ! conv = get_unformatted_convert (dtp->common.unit); ! if (conv == GFC_CONVERT_NONE) ! conv = compile_options.convert; ! ! /* We use big_endian, which is 0 on little-endian machines ! and 1 on big-endian machines. */ ! switch (conv) ! { ! case GFC_CONVERT_NATIVE: ! case GFC_CONVERT_SWAP: ! break; ! case GFC_CONVERT_BIG: ! conv = big_endian ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP; ! break; ! case GFC_CONVERT_LITTLE: ! conv = big_endian ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE; ! break; ! default: ! internal_error (&opp.common, "Illegal value for CONVERT"); ! break; ! } u_flags.convert = conv; *************** data_transfer_init (st_parameter_dt *dtp *** 1857,1863 **** return; } ! /* Check the record or position number. */ if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT && (cf & IOPARM_DT_HAS_REC) == 0) --- 1957,1963 ---- return; } ! /* Check the record number. */ if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT && (cf & IOPARM_DT_HAS_REC) == 0) *************** data_transfer_init (st_parameter_dt *dtp *** 1871,1877 **** && (cf & IOPARM_DT_HAS_REC) != 0) { generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, ! "Record number not allowed for sequential access data transfer"); return; } --- 1971,1978 ---- && (cf & IOPARM_DT_HAS_REC) != 0) { generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, ! "Record number not allowed for sequential access " ! "data transfer"); return; } *************** data_transfer_init (st_parameter_dt *dtp *** 1887,1893 **** if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) { generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, ! "ADVANCE specification conflicts with sequential access"); return; } --- 1988,1995 ---- if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) { generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, ! "ADVANCE specification conflicts with sequential " ! "access"); return; } *************** data_transfer_init (st_parameter_dt *dtp *** 1919,1928 **** return; } ! if ((cf & IOPARM_DT_HAS_SIZE) != 0 && dtp->u.p.advance_status != ADVANCE_NO) { generate_error (&dtp->common, LIBERROR_MISSING_OPTION, ! "SIZE specification requires an ADVANCE specification of NO"); return; } } --- 2021,2032 ---- return; } ! if ((cf & IOPARM_DT_HAS_SIZE) != 0 ! && dtp->u.p.advance_status != ADVANCE_NO) { generate_error (&dtp->common, LIBERROR_MISSING_OPTION, ! "SIZE specification requires an ADVANCE " ! "specification of NO"); return; } } *************** data_transfer_init (st_parameter_dt *dtp *** 1931,1951 **** if ((cf & IOPARM_END) != 0) { generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, ! "END specification cannot appear in a write statement"); return; } if ((cf & IOPARM_EOR) != 0) { generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, ! "EOR specification cannot appear in a write statement"); return; } if ((cf & IOPARM_DT_HAS_SIZE) != 0) { generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, ! "SIZE specification cannot appear in a write statement"); return; } } --- 2035,2058 ---- if ((cf & IOPARM_END) != 0) { generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, ! "END specification cannot appear in a write " ! "statement"); return; } if ((cf & IOPARM_EOR) != 0) { generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, ! "EOR specification cannot appear in a write " ! "statement"); return; } if ((cf & IOPARM_DT_HAS_SIZE) != 0) { generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, ! "SIZE specification cannot appear in a write " ! "statement"); return; } } *************** data_transfer_init (st_parameter_dt *dtp *** 1953,1958 **** --- 2060,2171 ---- if (dtp->u.p.advance_status == ADVANCE_UNSPECIFIED) dtp->u.p.advance_status = ADVANCE_YES; + /* Check the decimal mode. */ + dtp->u.p.current_unit->decimal_status + = !(cf & IOPARM_DT_HAS_DECIMAL) ? DECIMAL_UNSPECIFIED : + find_option (&dtp->common, dtp->decimal, dtp->decimal_len, + decimal_opt, "Bad DECIMAL parameter in data transfer " + "statement"); + + if (dtp->u.p.current_unit->decimal_status == DECIMAL_UNSPECIFIED) + dtp->u.p.current_unit->decimal_status = dtp->u.p.current_unit->flags.decimal; + + /* Check the sign mode. */ + dtp->u.p.sign_status + = !(cf & IOPARM_DT_HAS_SIGN) ? SIGN_UNSPECIFIED : + find_option (&dtp->common, dtp->sign, dtp->sign_len, sign_opt, + "Bad SIGN parameter in data transfer statement"); + + if (dtp->u.p.sign_status == SIGN_UNSPECIFIED) + dtp->u.p.sign_status = dtp->u.p.current_unit->flags.sign; + + /* Check the blank mode. */ + dtp->u.p.blank_status + = !(cf & IOPARM_DT_HAS_BLANK) ? BLANK_UNSPECIFIED : + find_option (&dtp->common, dtp->blank, dtp->blank_len, + blank_opt, + "Bad BLANK parameter in data transfer statement"); + + if (dtp->u.p.blank_status == BLANK_UNSPECIFIED) + dtp->u.p.blank_status = dtp->u.p.current_unit->flags.blank; + + /* Check the delim mode. */ + dtp->u.p.current_unit->delim_status + = !(cf & IOPARM_DT_HAS_DELIM) ? DELIM_UNSPECIFIED : + find_option (&dtp->common, dtp->delim, dtp->delim_len, + delim_opt, "Bad DELIM parameter in data transfer statement"); + + if (dtp->u.p.current_unit->delim_status == DELIM_UNSPECIFIED) + dtp->u.p.current_unit->delim_status = dtp->u.p.current_unit->flags.delim; + + /* Check the pad mode. */ + dtp->u.p.current_unit->pad_status + = !(cf & IOPARM_DT_HAS_PAD) ? PAD_UNSPECIFIED : + find_option (&dtp->common, dtp->pad, dtp->pad_len, pad_opt, + "Bad PAD parameter in data transfer statement"); + + if (dtp->u.p.current_unit->pad_status == PAD_UNSPECIFIED) + dtp->u.p.current_unit->pad_status = dtp->u.p.current_unit->flags.pad; + + /* Check the POS= specifier: that it is in range and that it is used with a + unit that has been connected for STREAM access. F2003 9.5.1.10. */ + + if (((cf & IOPARM_DT_HAS_POS) != 0)) + { + if (is_stream_io (dtp)) + { + + if (dtp->pos <= 0) + { + generate_error (&dtp->common, LIBERROR_BAD_OPTION, + "POS=specifier must be positive"); + return; + } + + if (dtp->pos >= dtp->u.p.current_unit->maxrec) + { + generate_error (&dtp->common, LIBERROR_BAD_OPTION, + "POS=specifier too large"); + return; + } + + dtp->rec = dtp->pos; + + if (dtp->u.p.mode == READING) + { + /* Required for compatibility between 4.3 and 4.4 runtime. Check + to see if we might be reading what we wrote before */ + if (dtp->u.p.current_unit->mode == WRITING) + { + fbuf_flush (dtp->u.p.current_unit, 1); + flush(dtp->u.p.current_unit->s); + } + + if (dtp->pos < file_length (dtp->u.p.current_unit->s)) + dtp->u.p.current_unit->endfile = NO_ENDFILE; + } + + if (dtp->pos != dtp->u.p.current_unit->strm_pos) + { + fbuf_flush (dtp->u.p.current_unit, 1); + flush (dtp->u.p.current_unit->s); + if (sseek (dtp->u.p.current_unit->s, dtp->pos - 1) == FAILURE) + { + generate_error (&dtp->common, LIBERROR_OS, NULL); + return; + } + dtp->u.p.current_unit->strm_pos = dtp->pos; + } + } + else + { + generate_error (&dtp->common, LIBERROR_BAD_OPTION, + "POS=specifier not allowed, " + "Try OPEN with ACCESS='stream'"); + return; + } + } + /* Sanity checks on the record number. */ if ((cf & IOPARM_DT_HAS_REC) != 0) { *************** data_transfer_init (st_parameter_dt *dtp *** 1975,1986 **** if (dtp->u.p.mode == READING && dtp->u.p.current_unit->mode == WRITING && !is_internal_unit (dtp)) ! flush(dtp->u.p.current_unit->s); /* Check whether the record exists to be read. Only a partial record needs to exist. */ ! if (dtp->u.p.mode == READING && (dtp->rec -1) * dtp->u.p.current_unit->recl >= file_length (dtp->u.p.current_unit->s)) { generate_error (&dtp->common, LIBERROR_BAD_OPTION, --- 2188,2202 ---- if (dtp->u.p.mode == READING && dtp->u.p.current_unit->mode == WRITING && !is_internal_unit (dtp)) ! { ! fbuf_flush (dtp->u.p.current_unit, 1); ! flush(dtp->u.p.current_unit->s); ! } /* Check whether the record exists to be read. Only a partial record needs to exist. */ ! if (dtp->u.p.mode == READING && (dtp->rec - 1) * dtp->u.p.current_unit->recl >= file_length (dtp->u.p.current_unit->s)) { generate_error (&dtp->common, LIBERROR_BAD_OPTION, *************** data_transfer_init (st_parameter_dt *dtp *** 1989,2005 **** } /* Position the file. */ ! if (!is_stream_io (dtp)) { ! if (sseek (dtp->u.p.current_unit->s, (gfc_offset) (dtp->rec - 1) ! * dtp->u.p.current_unit->recl) == FAILURE) ! { ! generate_error (&dtp->common, LIBERROR_OS, NULL); ! return; ! } } ! else dtp->u.p.current_unit->strm_pos = dtp->rec; } --- 2205,2231 ---- } /* Position the file. */ ! if (sseek (dtp->u.p.current_unit->s, (gfc_offset) (dtp->rec - 1) ! * dtp->u.p.current_unit->recl) == FAILURE) { ! generate_error (&dtp->common, LIBERROR_OS, NULL); ! return; } ! ! /* TODO: This is required to maintain compatibility between ! 4.3 and 4.4 runtime. Remove when ABI changes from 4.3 */ ! ! if (is_stream_io (dtp)) dtp->u.p.current_unit->strm_pos = dtp->rec; + + /* TODO: Un-comment this code when ABI changes from 4.3. + if (dtp->u.p.current_unit->flags.access == ACCESS_STREAM) + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "Record number not allowed for stream access " + "data transfer"); + return; + } */ } *************** data_transfer_init (st_parameter_dt *dtp *** 2016,2031 **** dtp->u.p.current_unit->mode = dtp->u.p.mode; - /* Set the initial value of flags. */ - - dtp->u.p.blank_status = dtp->u.p.current_unit->flags.blank; - dtp->u.p.sign_status = SIGN_S; - /* Set the maximum position reached from the previous I/O operation. This could be greater than zero from a previous non-advancing write. */ dtp->u.p.max_pos = dtp->u.p.current_unit->saved_pos; pre_position (dtp); /* Set up the subroutine that will handle the transfers. */ --- 2242,2253 ---- dtp->u.p.current_unit->mode = dtp->u.p.mode; /* Set the maximum position reached from the previous I/O operation. This could be greater than zero from a previous non-advancing write. */ dtp->u.p.max_pos = dtp->u.p.current_unit->saved_pos; pre_position (dtp); + /* Set up the subroutine that will handle the transfers. */ *************** next_array_record (st_parameter_dt *dtp, *** 2164,2177 **** read chunks of size MAX_READ until we get to the right position. */ - #define MAX_READ 4096 - static void skip_record (st_parameter_dt *dtp, size_t bytes) { gfc_offset new; ! int rlength, length; ! char *p; dtp->u.p.current_unit->bytes_left_subrecord += bytes; if (dtp->u.p.current_unit->bytes_left_subrecord == 0) --- 2386,2398 ---- read chunks of size MAX_READ until we get to the right position. */ static void skip_record (st_parameter_dt *dtp, size_t bytes) { gfc_offset new; ! size_t rlength; ! static const size_t MAX_READ = 4096; ! char p[MAX_READ]; dtp->u.p.current_unit->bytes_left_subrecord += bytes; if (dtp->u.p.current_unit->bytes_left_subrecord == 0) *************** skip_record (st_parameter_dt *dtp, size_ *** 2191,2214 **** { /* Seek by reading data. */ while (dtp->u.p.current_unit->bytes_left_subrecord > 0) { ! rlength = length = ! (MAX_READ > dtp->u.p.current_unit->bytes_left_subrecord) ? ! MAX_READ : dtp->u.p.current_unit->bytes_left_subrecord; ! p = salloc_r (dtp->u.p.current_unit->s, &rlength); ! if (p == NULL) { generate_error (&dtp->common, LIBERROR_OS, NULL); return; } ! dtp->u.p.current_unit->bytes_left_subrecord -= length; } } } - #undef MAX_READ /* Advance to the next record reading unformatted files, taking care of subrecords. If complete_record is nonzero, we loop --- 2412,2433 ---- { /* Seek by reading data. */ while (dtp->u.p.current_unit->bytes_left_subrecord > 0) { ! rlength = ! (MAX_READ > (size_t) dtp->u.p.current_unit->bytes_left_subrecord) ? ! MAX_READ : (size_t) dtp->u.p.current_unit->bytes_left_subrecord; ! if (sread (dtp->u.p.current_unit->s, p, &rlength) != 0) { generate_error (&dtp->common, LIBERROR_OS, NULL); return; } ! dtp->u.p.current_unit->bytes_left_subrecord -= rlength; } } } /* Advance to the next record reading unformatted files, taking care of subrecords. If complete_record is nonzero, we loop *************** next_record_r_unf (st_parameter_dt *dtp, *** 2236,2249 **** } } /* Space to the next record for read mode. */ static void next_record_r (st_parameter_dt *dtp) { gfc_offset record; ! int length, bytes_left; ! char *p; switch (current_mode (dtp)) { --- 2455,2477 ---- } } + + static inline gfc_offset + min_off (gfc_offset a, gfc_offset b) + { + return (a < b ? a : b); + } + + /* Space to the next record for read mode. */ static void next_record_r (st_parameter_dt *dtp) { gfc_offset record; ! int bytes_left; ! size_t length; ! char p; switch (current_mode (dtp)) { *************** next_record_r (st_parameter_dt *dtp) *** 2292,2309 **** else { bytes_left = (int) dtp->u.p.current_unit->bytes_left; ! p = salloc_r (dtp->u.p.current_unit->s, &bytes_left); ! if (p != NULL) ! dtp->u.p.current_unit->bytes_left ! = dtp->u.p.current_unit->recl; } break; } else do { ! p = salloc_r (dtp->u.p.current_unit->s, &length); ! ! if (p == NULL) { generate_error (&dtp->common, LIBERROR_OS, NULL); break; --- 2520,2543 ---- else { bytes_left = (int) dtp->u.p.current_unit->bytes_left; ! bytes_left = min_off (bytes_left, ! file_length (dtp->u.p.current_unit->s) ! - file_position (dtp->u.p.current_unit->s)); ! if (sseek (dtp->u.p.current_unit->s, ! file_position (dtp->u.p.current_unit->s) ! + bytes_left) == FAILURE) ! { ! generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); ! break; ! } ! dtp->u.p.current_unit->bytes_left ! = dtp->u.p.current_unit->recl; } break; } else do { ! if (sread (dtp->u.p.current_unit->s, &p, &length) != 0) { generate_error (&dtp->common, LIBERROR_OS, NULL); break; *************** next_record_r (st_parameter_dt *dtp) *** 2318,2324 **** if (is_stream_io (dtp)) dtp->u.p.current_unit->strm_pos++; } ! while (*p != '\n'); break; } --- 2552,2558 ---- if (is_stream_io (dtp)) dtp->u.p.current_unit->strm_pos++; } ! while (p != '\n'); break; } *************** write_us_marker (st_parameter_dt *dtp, c *** 2350,2356 **** len = compile_options.record_marker; /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */ ! if (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE) { switch (len) { --- 2584,2590 ---- len = compile_options.record_marker; /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */ ! if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE)) { switch (len) { *************** next_record_w_unf (st_parameter_dt *dtp, *** 2415,2421 **** else m_write = m; ! if (write_us_marker (dtp, m_write) != 0) goto io_error; if (compile_options.record_marker == 0) --- 2649,2655 ---- else m_write = m; ! if (unlikely (write_us_marker (dtp, m_write) != 0)) goto io_error; if (compile_options.record_marker == 0) *************** next_record_w_unf (st_parameter_dt *dtp, *** 2426,2433 **** /* Seek to the head and overwrite the bogus length with the real length. */ ! if (sseek (dtp->u.p.current_unit->s, c - m - record_marker) ! == FAILURE) goto io_error; if (next_subrecord) --- 2660,2667 ---- /* Seek to the head and overwrite the bogus length with the real length. */ ! if (unlikely (sseek (dtp->u.p.current_unit->s, c - m - record_marker) ! == FAILURE)) goto io_error; if (next_subrecord) *************** next_record_w_unf (st_parameter_dt *dtp, *** 2435,2446 **** else m_write = m; ! if (write_us_marker (dtp, m_write) != 0) goto io_error; /* Seek past the end of the current record. */ ! if (sseek (dtp->u.p.current_unit->s, c + record_marker) == FAILURE) goto io_error; return; --- 2669,2681 ---- else m_write = m; ! if (unlikely (write_us_marker (dtp, m_write) != 0)) goto io_error; /* Seek past the end of the current record. */ ! if (unlikely (sseek (dtp->u.p.current_unit->s, c + record_marker) ! == FAILURE)) goto io_error; return; *************** next_record_w (st_parameter_dt *dtp, int *** 2458,2465 **** { gfc_offset m, record, max_pos; int length; - char *p; /* Zero counters for X- and T-editing. */ max_pos = dtp->u.p.max_pos; dtp->u.p.max_pos = dtp->u.p.skips = dtp->u.p.pending_spaces = 0; --- 2693,2702 ---- { gfc_offset m, record, max_pos; int length; + /* Flush and reset the format buffer. */ + fbuf_flush (dtp->u.p.current_unit, 1); + /* Zero counters for X- and T-editing. */ max_pos = dtp->u.p.max_pos; dtp->u.p.max_pos = dtp->u.p.skips = dtp->u.p.pending_spaces = 0; *************** next_record_w (st_parameter_dt *dtp, int *** 2482,2495 **** case UNFORMATTED_DIRECT: if (dtp->u.p.current_unit->bytes_left > 0) ! { ! length = (int) dtp->u.p.current_unit->bytes_left; ! p = salloc_w (dtp->u.p.current_unit->s, &length); ! memset (p, 0, length); ! } ! ! if (sfree (dtp->u.p.current_unit->s) == FAILURE) ! goto io_error; break; case UNFORMATTED_SEQUENTIAL: --- 2719,2729 ---- case UNFORMATTED_DIRECT: if (dtp->u.p.current_unit->bytes_left > 0) ! { ! length = (int) dtp->u.p.current_unit->bytes_left; ! if (sset (dtp->u.p.current_unit->s, 0, length) == FAILURE) ! goto io_error; ! } break; case UNFORMATTED_SEQUENTIAL: *************** next_record_w (st_parameter_dt *dtp, int *** 2517,2523 **** if (max_pos > m) { length = (int) (max_pos - m); ! p = salloc_w (dtp->u.p.current_unit->s, &length); length = (int) (dtp->u.p.current_unit->recl - max_pos); } --- 2751,2763 ---- if (max_pos > m) { length = (int) (max_pos - m); ! if (sseek (dtp->u.p.current_unit->s, ! file_position (dtp->u.p.current_unit->s) ! + length) == FAILURE) ! { ! generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); ! return; ! } length = (int) (dtp->u.p.current_unit->recl - max_pos); } *************** next_record_w (st_parameter_dt *dtp, int *** 2559,2565 **** if (max_pos > m) { length = (int) (max_pos - m); ! p = salloc_w (dtp->u.p.current_unit->s, &length); length = (int) (dtp->u.p.current_unit->recl - max_pos); } else --- 2799,2811 ---- if (max_pos > m) { length = (int) (max_pos - m); ! if (sseek (dtp->u.p.current_unit->s, ! file_position (dtp->u.p.current_unit->s) ! + length) == FAILURE) ! { ! generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); ! return; ! } length = (int) (dtp->u.p.current_unit->recl - max_pos); } else *************** next_record_w (st_parameter_dt *dtp, int *** 2578,2592 **** size_t len; const char crlf[] = "\r\n"; - /* Move to the farthest position reached in preparation for - completing the record. (for file unit) */ - m = dtp->u.p.current_unit->recl - - dtp->u.p.current_unit->bytes_left; - if (max_pos > m) - { - length = (int) (max_pos - m); - p = salloc_w (dtp->u.p.current_unit->s, &length); - } #ifdef HAVE_CRLF len = 2; #else --- 2824,2829 ---- *************** next_record_w (st_parameter_dt *dtp, int *** 2596,2602 **** goto io_error; if (is_stream_io (dtp)) ! dtp->u.p.current_unit->strm_pos += len; } break; --- 2833,2844 ---- goto io_error; if (is_stream_io (dtp)) ! { ! dtp->u.p.current_unit->strm_pos += len; ! if (dtp->u.p.current_unit->strm_pos ! < file_length (dtp->u.p.current_unit->s)) ! struncate (dtp->u.p.current_unit->s); ! } } break; *************** finalize_transfer (st_parameter_dt *dtp) *** 2659,2665 **** GFC_INTEGER_4 cf = dtp->common.flags; if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ! *dtp->size = (GFC_IO_INT) dtp->u.p.size_used; if (dtp->u.p.eor_condition) { --- 2901,2907 ---- GFC_INTEGER_4 cf = dtp->common.flags; if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ! *dtp->size = dtp->u.p.size_used; if (dtp->u.p.eor_condition) { *************** finalize_transfer (st_parameter_dt *dtp) *** 2721,2726 **** --- 2963,2969 ---- if (!is_internal_unit (dtp) && dtp->u.p.seen_dollar) { dtp->u.p.seen_dollar = 0; + fbuf_flush (dtp->u.p.current_unit, 1); sfree (dtp->u.p.current_unit->s); return; } *************** finalize_transfer (st_parameter_dt *dtp) *** 2733,2738 **** --- 2976,2982 ---- - dtp->u.p.current_unit->bytes_left); dtp->u.p.current_unit->saved_pos = dtp->u.p.max_pos > 0 ? dtp->u.p.max_pos - bytes_written : 0; + fbuf_flush (dtp->u.p.current_unit, 0); flush (dtp->u.p.current_unit->s); return; } *************** st_write_done (st_parameter_dt *dtp) *** 2913,2918 **** --- 3157,3170 ---- library_end (); } + + /* F2003: This is a stub for the runtime portion of the WAIT statement. */ + void + st_wait (st_parameter_wait *wtp __attribute__((unused))) + { + } + + /* Receives the scalar information for namelist objects and stores it in a linked list of namelist_info types. */ diff -Nrcpad gcc-4.3.3/libgfortran/io/unit.c gcc-4.4.0/libgfortran/io/unit.c *** gcc-4.3.3/libgfortran/io/unit.c Sun Feb 10 18:06:34 2008 --- gcc-4.4.0/libgfortran/io/unit.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** ! /* Copyright (C) 2002, 2003, 2005, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with Libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "io.h" #include --- 1,27 ---- ! /* Copyright (C) 2002, 2003, 2005, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught + F2003 I/O support contributed by Jerry DeLisle This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "io.h" #include *************** insert_unit (int n) *** 209,221 **** static void destroy_unit_mutex (gfc_unit * u) { ! #ifdef __GTHREAD_MUTEX_DESTROY_FUNCTION ! __GTHREAD_MUTEX_DESTROY_FUNCTION (&u->lock); ! #else ! #ifdef __CYGWIN__ ! pthread_mutex_destroy (&u->lock); ! #endif ! #endif free_mem (u); } --- 205,211 ---- static void destroy_unit_mutex (gfc_unit * u) { ! __gthread_mutex_destroy (&u->lock); free_mem (u); } *************** get_internal_unit (st_parameter_dt *dtp) *** 436,455 **** iunit->maxrec=0; iunit->current_record=0; iunit->read_bad = 0; /* Set flags for the internal unit. */ iunit->flags.access = ACCESS_SEQUENTIAL; iunit->flags.action = ACTION_READWRITE; iunit->flags.form = FORM_FORMATTED; iunit->flags.pad = PAD_YES; iunit->flags.status = STATUS_UNSPECIFIED; ! iunit->endfile = NO_ENDFILE; /* Initialize the data transfer parameters. */ dtp->u.p.advance_status = ADVANCE_YES; - dtp->u.p.blank_status = BLANK_UNSPECIFIED; dtp->u.p.seen_dollar = 0; dtp->u.p.skips = 0; dtp->u.p.pending_spaces = 0; --- 426,449 ---- iunit->maxrec=0; iunit->current_record=0; iunit->read_bad = 0; + iunit->endfile = NO_ENDFILE; /* Set flags for the internal unit. */ iunit->flags.access = ACCESS_SEQUENTIAL; iunit->flags.action = ACTION_READWRITE; + iunit->flags.blank = BLANK_NULL; iunit->flags.form = FORM_FORMATTED; iunit->flags.pad = PAD_YES; iunit->flags.status = STATUS_UNSPECIFIED; ! iunit->flags.sign = SIGN_SUPPRESS; ! iunit->flags.decimal = DECIMAL_POINT; ! iunit->flags.encoding = ENCODING_DEFAULT; ! iunit->flags.async = ASYNC_NO; /* Initialize the data transfer parameters. */ dtp->u.p.advance_status = ADVANCE_YES; dtp->u.p.seen_dollar = 0; dtp->u.p.skips = 0; dtp->u.p.pending_spaces = 0; *************** init_units (void) *** 530,536 **** u->flags.blank = BLANK_NULL; u->flags.pad = PAD_YES; u->flags.position = POSITION_ASIS; ! u->recl = options.default_recl; u->endfile = NO_ENDFILE; --- 524,534 ---- u->flags.blank = BLANK_NULL; u->flags.pad = PAD_YES; u->flags.position = POSITION_ASIS; ! u->flags.sign = SIGN_SUPPRESS; ! u->flags.decimal = DECIMAL_POINT; ! u->flags.encoding = ENCODING_DEFAULT; ! u->flags.async = ASYNC_NO; ! u->recl = options.default_recl; u->endfile = NO_ENDFILE; *************** init_units (void) *** 553,558 **** --- 551,560 ---- u->flags.status = STATUS_OLD; u->flags.blank = BLANK_NULL; u->flags.position = POSITION_ASIS; + u->flags.sign = SIGN_SUPPRESS; + u->flags.decimal = DECIMAL_POINT; + u->flags.encoding = ENCODING_DEFAULT; + u->flags.async = ASYNC_NO; u->recl = options.default_recl; u->endfile = AT_ENDFILE; *************** init_units (void) *** 560,565 **** --- 562,569 ---- u->file_len = strlen (stdout_name); u->file = get_mem (u->file_len); memmove (u->file, stdout_name, u->file_len); + + fbuf_init (u, 0); __gthread_mutex_unlock (&u->lock); } *************** init_units (void) *** 576,581 **** --- 580,589 ---- u->flags.status = STATUS_OLD; u->flags.blank = BLANK_NULL; u->flags.position = POSITION_ASIS; + u->flags.sign = SIGN_SUPPRESS; + u->flags.decimal = DECIMAL_POINT; + u->flags.encoding = ENCODING_DEFAULT; + u->flags.async = ASYNC_NO; u->recl = options.default_recl; u->endfile = AT_ENDFILE; *************** init_units (void) *** 583,588 **** --- 591,599 ---- u->file_len = strlen (stderr_name); u->file = get_mem (u->file_len); memmove (u->file, stderr_name, u->file_len); + + fbuf_init (u, 256); /* 256 bytes should be enough, probably not doing + any kind of exotic formatting to stderr. */ __gthread_mutex_unlock (&u->lock); } *************** static int *** 602,608 **** close_unit_1 (gfc_unit *u, int locked) { int i, rc; ! /* If there are previously written bytes from a write with ADVANCE="no" Reposition the buffer before closing. */ if (u->previous_nonadvancing_write) --- 613,619 ---- close_unit_1 (gfc_unit *u, int locked) { int i, rc; ! /* If there are previously written bytes from a write with ADVANCE="no" Reposition the buffer before closing. */ if (u->previous_nonadvancing_write) *************** close_unit_1 (gfc_unit *u, int locked) *** 624,629 **** --- 635,642 ---- free_mem (u->file); u->file = NULL; u->file_len = 0; + + fbuf_destroy (u); if (!locked) __gthread_mutex_unlock (&u->lock); *************** filename_from_unit (int n) *** 726,735 **** void finish_last_advance_record (gfc_unit *u) { ! char *p; ! if (u->saved_pos > 0) ! p = salloc_w (u->s, &u->saved_pos); if (!(u->unit_number == options.stdout_unit || u->unit_number == options.stderr_unit)) --- 739,749 ---- void finish_last_advance_record (gfc_unit *u) { ! if (u->saved_pos > 0) ! fbuf_seek (u, u->saved_pos); ! ! fbuf_flush (u, 1); if (!(u->unit_number == options.stdout_unit || u->unit_number == options.stderr_unit)) diff -Nrcpad gcc-4.3.3/libgfortran/io/unix.c gcc-4.4.0/libgfortran/io/unix.c *** gcc-4.3.3/libgfortran/io/unix.c Sun Jan 20 06:33:49 2008 --- gcc-4.4.0/libgfortran/io/unix.c Thu Apr 9 23:23:07 2009 *************** *** 1,32 **** ! /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with Libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ /* Unix stream I/O module */ --- 1,28 ---- ! /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught + F2003 I/O support contributed by Jerry DeLisle This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ /* Unix stream I/O module */ *************** id_from_fd (const int fd) *** 93,100 **** #endif - - #ifndef SSIZE_MAX #define SSIZE_MAX SHRT_MAX #endif --- 89,94 ---- *************** typedef struct *** 153,159 **** int special_file; /* =1 if the fd refers to a special file */ ! int unbuffered; /* =1 if the stream is not buffered */ char *buffer; char small_buffer[BUFFER_SIZE]; --- 147,153 ---- int special_file; /* =1 if the fd refers to a special file */ ! io_mode method; /* Method of stream I/O being used */ char *buffer; char small_buffer[BUFFER_SIZE]; *************** typedef struct *** 184,190 **** int special_file; /* =1 if the fd refers to a special file */ ! int unbuffered; /* =1 if the stream is not buffered */ char *buffer; } --- 178,184 ---- int special_file; /* =1 if the fd refers to a special file */ ! io_mode method; /* Method of stream I/O being used */ char *buffer; } *************** move_pos_offset (stream* st, int pos_off *** 238,252 **** str->logical_offset += pos_off; if (str->dirty_offset + str->ndirty > str->logical_offset) ! { ! if (str->ndirty + pos_off > 0) ! str->ndirty += pos_off; ! else ! { ! str->dirty_offset += pos_off + pos_off; ! str->ndirty = 0; ! } ! } return pos_off; } --- 232,246 ---- str->logical_offset += pos_off; if (str->dirty_offset + str->ndirty > str->logical_offset) ! { ! if (str->ndirty + pos_off > 0) ! str->ndirty += pos_off; ! else ! { ! str->dirty_offset += pos_off + pos_off; ! str->ndirty = 0; ! } ! } return pos_off; } *************** fd_alloc (unix_stream * s, gfc_offset wh *** 531,542 **** * NULL on I/O error. */ static char * ! fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where) { gfc_offset m; ! ! if (where == -1) ! where = s->logical_offset; if (s->buffer != NULL && s->buffer_offset <= where && where + *len <= s->buffer_offset + s->active) --- 525,534 ---- * NULL on I/O error. */ static char * ! fd_alloc_r_at (unix_stream * s, int *len) { gfc_offset m; ! gfc_offset where = s->logical_offset; if (s->buffer != NULL && s->buffer_offset <= where && where + *len <= s->buffer_offset + s->active) *************** fd_alloc_r_at (unix_stream * s, int *len *** 594,605 **** * we've already buffered the data or we need to load it. */ static char * ! fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where) { gfc_offset n; ! ! if (where == -1) ! where = s->logical_offset; if (s->buffer == NULL || s->buffer_offset > where || where + *len > s->buffer_offset + s->len) --- 586,595 ---- * we've already buffered the data or we need to load it. */ static char * ! fd_alloc_w_at (unix_stream * s, int *len) { gfc_offset n; ! gfc_offset where = s->logical_offset; if (s->buffer == NULL || s->buffer_offset > where || where + *len > s->buffer_offset + s->len) *************** fd_alloc_w_at (unix_stream * s, int *len *** 615,637 **** || where > s->dirty_offset + s->ndirty || s->dirty_offset > where + *len) { /* Discontiguous blocks, start with a clean buffer. */ ! /* Flush the buffer. */ ! if (s->ndirty != 0) ! fd_flush (s); ! s->dirty_offset = where; ! s->ndirty = *len; } else { gfc_offset start; /* Merge with the existing data. */ if (where < s->dirty_offset) ! start = where; else ! start = s->dirty_offset; if (where + *len > s->dirty_offset + s->ndirty) ! s->ndirty = where + *len - start; else ! s->ndirty = s->dirty_offset + s->ndirty - start; s->dirty_offset = start; } --- 605,627 ---- || where > s->dirty_offset + s->ndirty || s->dirty_offset > where + *len) { /* Discontiguous blocks, start with a clean buffer. */ ! /* Flush the buffer. */ ! if (s->ndirty != 0) ! fd_flush (s); ! s->dirty_offset = where; ! s->ndirty = *len; } else { gfc_offset start; /* Merge with the existing data. */ if (where < s->dirty_offset) ! start = where; else ! start = s->dirty_offset; if (where + *len > s->dirty_offset + s->ndirty) ! s->ndirty = where + *len - start; else ! s->ndirty = s->dirty_offset + s->ndirty - start; s->dirty_offset = start; } *************** fd_sfree (unix_stream * s) *** 655,661 **** { if (s->ndirty != 0 && (s->buffer != s->small_buffer || options.all_unbuffered || ! s->unbuffered)) return fd_flush (s); return SUCCESS; --- 645,651 ---- { if (s->ndirty != 0 && (s->buffer != s->small_buffer || options.all_unbuffered || ! s->method == SYNC_UNBUFFERED)) return fd_flush (s); return SUCCESS; *************** fd_truncate (unix_stream * s) *** 706,721 **** /* Using ftruncate on a seekable special file (like /dev/null) is undefined, so we treat it as if the ftruncate succeeded. */ #ifdef HAVE_FTRUNCATE ! if (s->special_file || ftruncate (s->fd, s->logical_offset)) #else ! #ifdef HAVE_CHSIZE ! if (s->special_file || chsize (s->fd, s->logical_offset)) ! #endif #endif { ! s->physical_offset = s->file_length = 0; ! return SUCCESS; } s->physical_offset = s->file_length = s->logical_offset; --- 696,723 ---- /* Using ftruncate on a seekable special file (like /dev/null) is undefined, so we treat it as if the ftruncate succeeded. */ + if (!s->special_file + && ( #ifdef HAVE_FTRUNCATE ! ftruncate (s->fd, s->logical_offset) != 0 ! #elif defined HAVE_CHSIZE ! chsize (s->fd, s->logical_offset) != 0 #else ! /* If we have neither, always fail and exit, noisily. */ ! runtime_error ("required ftruncate or chsize support not present"), 1 #endif + )) { ! /* The truncation failed and we need to handle this gracefully. ! The file length remains the same, but the file-descriptor ! offset needs adjustment per the successful lseek above. ! (Similarly, the contents of the buffer isn't valid anymore.) ! A ftruncate call does not affect the physical (file-descriptor) ! offset, according to the ftruncate manual, so neither should a ! failed call. */ ! s->physical_offset = s->logical_offset; ! s->active = 0; ! return FAILURE; } s->physical_offset = s->file_length = s->logical_offset; *************** fd_sset (unix_stream * s, int c, size_t *** 741,747 **** /* memset() in chunks of BUFFER_SIZE. */ trans = (bytes_left < BUFFER_SIZE) ? bytes_left : BUFFER_SIZE; ! p = fd_alloc_w_at (s, &trans, -1); if (p) memset (p, c, trans); else --- 743,749 ---- /* memset() in chunks of BUFFER_SIZE. */ trans = (bytes_left < BUFFER_SIZE) ? bytes_left : BUFFER_SIZE; ! p = fd_alloc_w_at (s, &trans); if (p) memset (p, c, trans); else *************** fd_read (unix_stream * s, void * buf, si *** 765,774 **** void *p; int tmp, status; ! if (*nbytes < BUFFER_SIZE && !s->unbuffered) { tmp = *nbytes; ! p = fd_alloc_r_at (s, &tmp, -1); if (p) { *nbytes = tmp; --- 767,776 ---- void *p; int tmp, status; ! if (*nbytes < BUFFER_SIZE && s->method == SYNC_BUFFERED) { tmp = *nbytes; ! p = fd_alloc_r_at (s, &tmp); if (p) { *nbytes = tmp; *************** fd_write (unix_stream * s, const void * *** 813,822 **** void *p; int tmp, status; ! if (*nbytes < BUFFER_SIZE && !s->unbuffered) { tmp = *nbytes; ! p = fd_alloc_w_at (s, &tmp, -1); if (p) { *nbytes = tmp; --- 815,824 ---- void *p; int tmp, status; ! if (*nbytes < BUFFER_SIZE && s->method == SYNC_BUFFERED) { tmp = *nbytes; ! p = fd_alloc_w_at (s, &tmp); if (p) { *nbytes = tmp; *************** fd_close (unix_stream * s) *** 859,868 **** if (s->buffer != NULL && s->buffer != s->small_buffer) free_mem (s->buffer); ! if (s->fd != STDOUT_FILENO && s->fd != STDERR_FILENO) { if (close (s->fd) < 0) ! return FAILURE; } free_mem (s); --- 861,870 ---- if (s->buffer != NULL && s->buffer != s->small_buffer) free_mem (s->buffer); ! if (s->fd != STDOUT_FILENO && s->fd != STDERR_FILENO && s->fd != STDIN_FILENO) { if (close (s->fd) < 0) ! return FAILURE; } free_mem (s); *************** static void *** 875,883 **** fd_open (unix_stream * s) { if (isatty (s->fd)) ! s->unbuffered = 1; - s->st.alloc_r_at = (void *) fd_alloc_r_at; s->st.alloc_w_at = (void *) fd_alloc_w_at; s->st.sfree = (void *) fd_sfree; s->st.close = (void *) fd_close; --- 877,886 ---- fd_open (unix_stream * s) { if (isatty (s->fd)) ! s->method = SYNC_UNBUFFERED; ! else ! s->method = SYNC_BUFFERED; s->st.alloc_w_at = (void *) fd_alloc_w_at; s->st.sfree = (void *) fd_sfree; s->st.close = (void *) fd_close; *************** fd_open (unix_stream * s) *** 905,916 **** static char * ! mem_alloc_r_at (int_stream * s, int *len, gfc_offset where) { gfc_offset n; ! ! if (where == -1) ! where = s->logical_offset; if (where < s->buffer_offset || where > s->buffer_offset + s->active) return NULL; --- 908,917 ---- static char * ! mem_alloc_r_at (int_stream * s, int *len) { gfc_offset n; ! gfc_offset where = s->logical_offset; if (where < s->buffer_offset || where > s->buffer_offset + s->active) return NULL; *************** mem_alloc_r_at (int_stream * s, int *len *** 926,940 **** static char * ! mem_alloc_w_at (int_stream * s, int *len, gfc_offset where) { gfc_offset m; assert (*len >= 0); /* Negative values not allowed. */ - if (where == -1) - where = s->logical_offset; - m = where + *len; if (where < s->buffer_offset) --- 927,939 ---- static char * ! mem_alloc_w_at (int_stream * s, int *len) { gfc_offset m; + gfc_offset where = s->logical_offset; assert (*len >= 0); /* Negative values not allowed. */ m = where + *len; if (where < s->buffer_offset) *************** mem_alloc_w_at (int_stream * s, int *len *** 949,957 **** } ! /* Stream read function for internal units. This is not actually used ! at the moment, as all internal IO is formatted and the formatted IO ! routines use mem_alloc_r_at. */ static int mem_read (int_stream * s, void * buf, size_t * nbytes) --- 948,954 ---- } ! /* Stream read function for internal units. */ static int mem_read (int_stream * s, void * buf, size_t * nbytes) *************** mem_read (int_stream * s, void * buf, si *** 960,966 **** int tmp; tmp = *nbytes; ! p = mem_alloc_r_at (s, &tmp, -1); if (p) { *nbytes = tmp; --- 957,963 ---- int tmp; tmp = *nbytes; ! p = mem_alloc_r_at (s, &tmp); if (p) { *nbytes = tmp; *************** mem_read (int_stream * s, void * buf, si *** 970,976 **** else { *nbytes = 0; ! return errno; } } --- 967,973 ---- else { *nbytes = 0; ! return 0; } } *************** mem_write (int_stream * s, const void * *** 985,994 **** void *p; int tmp; - errno = 0; - tmp = *nbytes; ! p = mem_alloc_w_at (s, &tmp, -1); if (p) { *nbytes = tmp; --- 982,989 ---- void *p; int tmp; tmp = *nbytes; ! p = mem_alloc_w_at (s, &tmp); if (p) { *nbytes = tmp; *************** mem_write (int_stream * s, const void * *** 998,1004 **** else { *nbytes = 0; ! return errno; } } --- 993,999 ---- else { *nbytes = 0; ! return 0; } } *************** mem_set (int_stream * s, int c, size_t n *** 1025,1031 **** len = n; ! p = mem_alloc_w_at (s, &len, -1); if (p) { memset (p, c, len); --- 1020,1026 ---- len = n; ! p = mem_alloc_w_at (s, &len); if (p) { memset (p, c, len); *************** open_internal (char *base, int length, g *** 1091,1097 **** s->logical_offset = 0; s->active = s->file_length = length; - s->st.alloc_r_at = (void *) mem_alloc_r_at; s->st.alloc_w_at = (void *) mem_alloc_w_at; s->st.sfree = (void *) mem_sfree; s->st.close = (void *) mem_close; --- 1086,1091 ---- *************** tempfile (st_parameter_open *opp) *** 1212,1218 **** do #if defined(HAVE_CRLF) && defined(O_BINARY) fd = open (template, O_RDWR | O_CREAT | O_EXCL | O_BINARY, ! S_IREAD | S_IWRITE); #else fd = open (template, O_RDWR | O_CREAT | O_EXCL, S_IREAD | S_IWRITE); #endif --- 1206,1212 ---- do #if defined(HAVE_CRLF) && defined(O_BINARY) fd = open (template, O_RDWR | O_CREAT | O_EXCL | O_BINARY, ! S_IREAD | S_IWRITE); #else fd = open (template, O_RDWR | O_CREAT | O_EXCL, S_IREAD | S_IWRITE); #endif *************** regular_file (st_parameter_open *opp, un *** 1323,1333 **** if (fd >=0) { flags->action = ACTION_READ; ! return fd; /* success */ } if (errno != EACCES) ! return fd; /* failure */ /* retry for write-only access */ rwflag = O_WRONLY; --- 1317,1327 ---- if (fd >=0) { flags->action = ACTION_READ; ! return fd; /* success */ } if (errno != EACCES) ! return fd; /* failure */ /* retry for write-only access */ rwflag = O_WRONLY; *************** regular_file (st_parameter_open *opp, un *** 1335,1343 **** if (fd >=0) { flags->action = ACTION_WRITE; ! return fd; /* success */ } ! return fd; /* failure */ } --- 1329,1337 ---- if (fd >=0) { flags->action = ACTION_WRITE; ! return fd; /* success */ } ! return fd; /* failure */ } *************** open_external (st_parameter_open *opp, u *** 1354,1360 **** { fd = tempfile (opp); if (flags->action == ACTION_UNSPECIFIED) ! flags->action = ACTION_READWRITE; #if HAVE_UNLINK_OPEN_FILE /* We can unlink scratch files now and it will go away when closed. */ --- 1348,1354 ---- { fd = tempfile (opp); if (flags->action == ACTION_UNSPECIFIED) ! flags->action = ACTION_READWRITE; #if HAVE_UNLINK_OPEN_FILE /* We can unlink scratch files now and it will go away when closed. */ *************** output_stream (void) *** 1419,1425 **** s = fd_to_stream (STDOUT_FILENO, PROT_WRITE); if (options.unbuffered_preconnected) ! ((unix_stream *) s)->unbuffered = 1; return s; } --- 1413,1419 ---- s = fd_to_stream (STDOUT_FILENO, PROT_WRITE); if (options.unbuffered_preconnected) ! ((unix_stream *) s)->method = SYNC_UNBUFFERED; return s; } *************** error_stream (void) *** 1438,1444 **** s = fd_to_stream (STDERR_FILENO, PROT_WRITE); if (options.unbuffered_preconnected) ! ((unix_stream *) s)->unbuffered = 1; return s; } --- 1432,1438 ---- s = fd_to_stream (STDERR_FILENO, PROT_WRITE); if (options.unbuffered_preconnected) ! ((unix_stream *) s)->method = SYNC_UNBUFFERED; return s; } *************** stream_offset (stream *s) *** 2038,2050 **** the solution used by f2c. Each record contains a pair of length markers: ! Length of record n in bytes ! Data of record n ! Length of record n in bytes ! Length of record n+1 in bytes ! Data of record n+1 ! Length of record n+1 in bytes The length is stored at the end of a record to allow backspacing to the previous record. Between data transfer statements, the file pointer --- 2032,2044 ---- the solution used by f2c. Each record contains a pair of length markers: ! Length of record n in bytes ! Data of record n ! Length of record n in bytes ! Length of record n+1 in bytes ! Data of record n+1 ! Length of record n+1 in bytes The length is stored at the end of a record to allow backspacing to the previous record. Between data transfer statements, the file pointer diff -Nrcpad gcc-4.3.3/libgfortran/io/write.c gcc-4.4.0/libgfortran/io/write.c *** gcc-4.3.3/libgfortran/io/write.c Wed Oct 29 04:44:15 2008 --- gcc-4.4.0/libgfortran/io/write.c Thu Apr 9 23:23:07 2009 *************** *** 1,32 **** ! /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught Namelist output contributed by Paul Thomas This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with Libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "io.h" #include --- 1,29 ---- ! /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 ! Free Software Foundation, Inc. Contributed by Andy Vaught Namelist output contributed by Paul Thomas + F2003 I/O support contributed by Jerry DeLisle This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "io.h" #include *************** Boston, MA 02110-1301, USA. */ *** 34,50 **** #include #include #include #define star_fill(p, n) memset(p, '*', n) #include "write_float.def" void write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len) { int wlen; char *p; ! wlen = f->u.string.length < 0 ? len : f->u.string.length; #ifdef HAVE_CRLF /* If this is formatted STREAM IO convert any embedded line feed characters --- 31,198 ---- #include #include #include + #include #define star_fill(p, n) memset(p, '*', n) #include "write_float.def" + typedef unsigned char uchar; + + /* Write out default char4. */ + + static void + write_default_char4 (st_parameter_dt *dtp, gfc_char4_t *source, + int src_len, int w_len) + { + char *p; + int j, k = 0; + gfc_char4_t c; + uchar d; + + /* Take care of preceding blanks. */ + if (w_len > src_len) + { + k = w_len - src_len; + p = write_block (dtp, k); + if (p == NULL) + return; + memset (p, ' ', k); + } + + /* Get ready to handle delimiters if needed. */ + switch (dtp->u.p.current_unit->delim_status) + { + case DELIM_APOSTROPHE: + d = '\''; + break; + case DELIM_QUOTE: + d = '"'; + break; + default: + d = ' '; + break; + } + + /* Now process the remaining characters, one at a time. */ + for (j = k; j < src_len; j++) + { + c = source[j]; + + /* Handle delimiters if any. */ + if (c == d && d != ' ') + { + p = write_block (dtp, 2); + if (p == NULL) + return; + *p++ = (uchar) c; + } + else + { + p = write_block (dtp, 1); + if (p == NULL) + return; + } + *p = c > 255 ? '?' : (uchar) c; + } + } + + + /* Write out UTF-8 converted from char4. */ + + static void + write_utf8_char4 (st_parameter_dt *dtp, gfc_char4_t *source, + int src_len, int w_len) + { + char *p; + int j, k = 0; + gfc_char4_t c; + static const uchar masks[6] = { 0x00, 0xC0, 0xE0, 0xF0, 0xF8, 0xFC }; + static const uchar limits[6] = { 0x80, 0xE0, 0xF0, 0xF8, 0xFC, 0xFE }; + size_t nbytes; + uchar buf[6], d, *q; + + /* Take care of preceding blanks. */ + if (w_len > src_len) + { + k = w_len - src_len; + p = write_block (dtp, k); + if (p == NULL) + return; + memset (p, ' ', k); + } + + /* Get ready to handle delimiters if needed. */ + switch (dtp->u.p.current_unit->delim_status) + { + case DELIM_APOSTROPHE: + d = '\''; + break; + case DELIM_QUOTE: + d = '"'; + break; + default: + d = ' '; + break; + } + + /* Now process the remaining characters, one at a time. */ + for (j = k; j < src_len; j++) + { + c = source[j]; + if (c < 0x80) + { + /* Handle the delimiters if any. */ + if (c == d && d != ' ') + { + p = write_block (dtp, 2); + if (p == NULL) + return; + *p++ = (uchar) c; + } + else + { + p = write_block (dtp, 1); + if (p == NULL) + return; + } + *p = (uchar) c; + } + else + { + /* Convert to UTF-8 sequence. */ + nbytes = 1; + q = &buf[6]; + + do + { + *--q = ((c & 0x3F) | 0x80); + c >>= 6; + nbytes++; + } + while (c >= 0x3F || (c & limits[nbytes-1])); + + *--q = (c | masks[nbytes-1]); + + p = write_block (dtp, nbytes); + if (p == NULL) + return; + + while (q < &buf[6]) + *p++ = *q++; + } + } + } + + void write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len) { int wlen; char *p; ! wlen = f->u.string.length < 0 ! || (f->format == FMT_G && f->u.string.length == 0) ! ? len : f->u.string.length; #ifdef HAVE_CRLF /* If this is formatted STREAM IO convert any embedded line feed characters *************** write_a (st_parameter_dt *dtp, const fno *** 120,125 **** --- 268,358 ---- #endif } + + /* The primary difference between write_a_char4 and write_a is that we have to + deal with writing from the first byte of the 4-byte character and pay + attention to the most significant bytes. For ENCODING="default" write the + lowest significant byte. If the 3 most significant bytes contain + non-zero values, emit a '?'. For ENCODING="utf-8", convert the UCS-32 value + to the UTF-8 encoded string before writing out. */ + + void + write_a_char4 (st_parameter_dt *dtp, const fnode *f, const char *source, int len) + { + int wlen; + gfc_char4_t *q; + + wlen = f->u.string.length < 0 + || (f->format == FMT_G && f->u.string.length == 0) + ? len : f->u.string.length; + + q = (gfc_char4_t *) source; + #ifdef HAVE_CRLF + /* If this is formatted STREAM IO convert any embedded line feed characters + to CR_LF on systems that use that sequence for newlines. See F2003 + Standard sections 10.6.3 and 9.9 for further information. */ + if (is_stream_io (dtp)) + { + const char crlf[] = "\r\n"; + int i, bytes; + gfc_char4_t *qq; + bytes = 0; + + /* Write out any padding if needed. */ + if (len < wlen) + { + char *p; + p = write_block (dtp, wlen - len); + if (p == NULL) + return; + memset (p, ' ', wlen - len); + } + + /* Scan the source string looking for '\n' and convert it if found. */ + qq = (gfc_char4_t *) source; + for (i = 0; i < wlen; i++) + { + if (qq[i] == '\n') + { + /* Write out the previously scanned characters in the string. */ + if (bytes > 0) + { + if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8) + write_utf8_char4 (dtp, q, bytes, 0); + else + write_default_char4 (dtp, q, bytes, 0); + bytes = 0; + } + + /* Write out the CR_LF sequence. */ + write_default_char4 (dtp, crlf, 2, 0); + } + else + bytes++; + } + + /* Write out any remaining bytes if no LF was found. */ + if (bytes > 0) + { + if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8) + write_utf8_char4 (dtp, q, bytes, 0); + else + write_default_char4 (dtp, q, bytes, 0); + } + } + else + { + #endif + if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8) + write_utf8_char4 (dtp, q, len, wlen); + else + write_default_char4 (dtp, q, len, wlen); + #ifdef HAVE_CRLF + } + #endif + } + + static GFC_INTEGER_LARGEST extract_int (const void *p, int len) { *************** void *** 233,247 **** write_l (st_parameter_dt *dtp, const fnode *f, char *source, int len) { char *p; GFC_INTEGER_LARGEST n; ! p = write_block (dtp, f->u.w); if (p == NULL) return; ! memset (p, ' ', f->u.w - 1); n = extract_int (source, len); ! p[f->u.w - 1] = (n) ? 'T' : 'F'; } --- 466,483 ---- write_l (st_parameter_dt *dtp, const fnode *f, char *source, int len) { char *p; + int wlen; GFC_INTEGER_LARGEST n; ! wlen = (f->format == FMT_G && f->u.w == 0) ? 1 : f->u.w; ! ! p = write_block (dtp, wlen); if (p == NULL) return; ! memset (p, ' ', wlen - 1); n = extract_int (source, len); ! p[wlen - 1] = (n) ? 'T' : 'F'; } *************** write_decimal (st_parameter_dt *dtp, con *** 338,349 **** char itoa_buf[GFC_BTOA_BUF_SIZE]; w = f->u.integer.w; ! m = f->u.integer.m; n = extract_int (source, len); /* Special case: */ - if (m == 0 && n == 0) { if (w == 0) --- 574,584 ---- char itoa_buf[GFC_BTOA_BUF_SIZE]; w = f->u.integer.w; ! m = f->format == FMT_G ? -1 : f->u.integer.m; n = extract_int (source, len); /* Special case: */ if (m == 0 && n == 0) { if (w == 0) *************** write_decimal (st_parameter_dt *dtp, con *** 360,368 **** sign = calculate_sign (dtp, n < 0); if (n < 0) n = -n; ! ! nsign = sign == SIGN_NONE ? 0 : 1; q = conv (n, itoa_buf, sizeof (itoa_buf)); digits = strlen (q); --- 595,610 ---- sign = calculate_sign (dtp, n < 0); if (n < 0) n = -n; ! nsign = sign == S_NONE ? 0 : 1; ! ! /* conv calls gfc_itoa which sets the negative sign needed ! by write_integer. The sign '+' or '-' is set below based on sign ! calculated above, so we just point past the sign in the string ! before proceeding to avoid double signs in corner cases. ! (see PR38504) */ q = conv (n, itoa_buf, sizeof (itoa_buf)); + if (*q == '-') + q++; digits = strlen (q); *************** write_decimal (st_parameter_dt *dtp, con *** 395,407 **** switch (sign) { ! case SIGN_PLUS: *p++ = '+'; break; ! case SIGN_MINUS: *p++ = '-'; break; ! case SIGN_NONE: break; } --- 637,649 ---- switch (sign) { ! case S_PLUS: *p++ = '+'; break; ! case S_MINUS: *p++ = '-'; break; ! case S_NONE: break; } *************** write_integer (st_parameter_dt *dtp, con *** 633,644 **** the strings if the file has been opened in that mode. */ static void ! write_character (st_parameter_dt *dtp, const char *source, int length) { int i, extra; char *p, d; ! switch (dtp->u.p.current_unit->flags.delim) { case DELIM_APOSTROPHE: d = '\''; --- 875,886 ---- the strings if the file has been opened in that mode. */ static void ! write_character (st_parameter_dt *dtp, const char *source, int kind, int length) { int i, extra; char *p, d; ! switch (dtp->u.p.current_unit->delim_status) { case DELIM_APOSTROPHE: d = '\''; *************** write_character (st_parameter_dt *dtp, c *** 651,739 **** break; } ! if (d == ' ') ! extra = 0; ! else { ! extra = 2; ! for (i = 0; i < length; i++) ! if (source[i] == d) ! extra++; ! } ! p = write_block (dtp, length + extra); ! if (p == NULL) ! return; ! if (d == ' ') ! memcpy (p, source, length); else { ! *p++ = d; ! ! for (i = 0; i < length; i++) { ! *p++ = source[i]; ! if (source[i] == d) ! *p++ = d; } ! *p = d; } } ! /* Output a real number with default format. ! This is 1PG14.7E2 for REAL(4), 1PG23.15E3 for REAL(8), ! 1PG28.19E4 for REAL(10) and 1PG43.34E4 for REAL(16). */ static void ! write_real (st_parameter_dt *dtp, const char *source, int length) { ! fnode f ; ! int org_scale = dtp->u.p.scale_factor; ! f.format = FMT_G; ! dtp->u.p.scale_factor = 1; switch (length) { case 4: ! f.u.real.w = 15; ! f.u.real.d = 8; ! f.u.real.e = 2; break; case 8: ! f.u.real.w = 25; ! f.u.real.d = 17; ! f.u.real.e = 3; break; case 10: ! f.u.real.w = 29; ! f.u.real.d = 20; ! f.u.real.e = 4; break; case 16: ! f.u.real.w = 44; ! f.u.real.d = 35; ! f.u.real.e = 4; break; default: internal_error (&dtp->common, "bad real kind"); break; } write_float (dtp, &f, source , length); dtp->u.p.scale_factor = org_scale; } static void write_complex (st_parameter_dt *dtp, const char *source, int kind, size_t size) { if (write_char (dtp, '(')) return; write_real (dtp, source, kind); ! if (write_char (dtp, ',')) return; write_real (dtp, source + size / 2, kind); --- 893,1030 ---- break; } ! if (kind == 1) { ! if (d == ' ') ! extra = 0; ! else ! { ! extra = 2; ! for (i = 0; i < length; i++) ! if (source[i] == d) ! extra++; ! } ! p = write_block (dtp, length + extra); ! if (p == NULL) ! return; ! if (d == ' ') ! memcpy (p, source, length); ! else ! { ! *p++ = d; ! ! for (i = 0; i < length; i++) ! { ! *p++ = source[i]; ! if (source[i] == d) ! *p++ = d; ! } ! ! *p = d; ! } ! } else { ! if (d == ' ') { ! if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8) ! write_utf8_char4 (dtp, (gfc_char4_t *) source, length, 0); ! else ! write_default_char4 (dtp, (gfc_char4_t *) source, length, 0); } + else + { + p = write_block (dtp, 1); + *p = d; ! if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8) ! write_utf8_char4 (dtp, (gfc_char4_t *) source, length, 0); ! else ! write_default_char4 (dtp, (gfc_char4_t *) source, length, 0); ! ! p = write_block (dtp, 1); ! *p = d; ! } } } ! /* Set an fnode to default format. */ static void ! set_fnode_default (st_parameter_dt *dtp, fnode *f, int length) { ! f->format = FMT_G; switch (length) { case 4: ! f->u.real.w = 15; ! f->u.real.d = 8; ! f->u.real.e = 2; break; case 8: ! f->u.real.w = 25; ! f->u.real.d = 17; ! f->u.real.e = 3; break; case 10: ! f->u.real.w = 29; ! f->u.real.d = 20; ! f->u.real.e = 4; break; case 16: ! f->u.real.w = 44; ! f->u.real.d = 35; ! f->u.real.e = 4; break; default: internal_error (&dtp->common, "bad real kind"); break; } + } + /* Output a real number with default format. + This is 1PG14.7E2 for REAL(4), 1PG23.15E3 for REAL(8), + 1PG28.19E4 for REAL(10) and 1PG43.34E4 for REAL(16). */ + + void + write_real (st_parameter_dt *dtp, const char *source, int length) + { + fnode f ; + int org_scale = dtp->u.p.scale_factor; + dtp->u.p.scale_factor = 1; + set_fnode_default (dtp, &f, length); write_float (dtp, &f, source , length); dtp->u.p.scale_factor = org_scale; } + void + write_real_g0 (st_parameter_dt *dtp, const char *source, int length, int d) + { + fnode f ; + set_fnode_default (dtp, &f, length); + if (d > 0) + f.u.real.d = d; + dtp->u.p.g0_no_blanks = 1; + write_float (dtp, &f, source , length); + dtp->u.p.g0_no_blanks = 0; + } + + static void write_complex (st_parameter_dt *dtp, const char *source, int kind, size_t size) { + char semi_comma = + dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? ',' : ';'; + if (write_char (dtp, '(')) return; write_real (dtp, source, kind); ! if (write_char (dtp, semi_comma)) return; write_real (dtp, source + size / 2, kind); *************** list_formatted_write_scalar (st_paramete *** 775,782 **** else { if (type != BT_CHARACTER || !dtp->u.p.char_flag || ! dtp->u.p.current_unit->flags.delim != DELIM_NONE) ! write_separator (dtp); } switch (type) --- 1066,1073 ---- else { if (type != BT_CHARACTER || !dtp->u.p.char_flag || ! dtp->u.p.current_unit->delim_status != DELIM_NONE) ! write_separator (dtp); } switch (type) *************** list_formatted_write_scalar (st_paramete *** 788,794 **** write_logical (dtp, p, kind); break; case BT_CHARACTER: ! write_character (dtp, p, kind); break; case BT_REAL: write_real (dtp, p, kind); --- 1079,1085 ---- write_logical (dtp, p, kind); break; case BT_CHARACTER: ! write_character (dtp, p, kind, size); break; case BT_REAL: write_real (dtp, p, kind); *************** list_formatted_write (st_parameter_dt *d *** 810,815 **** --- 1101,1108 ---- { size_t elem; char *tmp; + size_t stride = type == BT_CHARACTER ? + size * GFC_SIZE_OF_CHAR_KIND(kind) : size; tmp = (char *) p; *************** list_formatted_write (st_parameter_dt *d *** 817,823 **** for (elem = 0; elem < nelems; elem++) { dtp->u.p.item_count++; ! list_formatted_write_scalar (dtp, type, tmp + size*elem, kind, size); } } --- 1110,1116 ---- for (elem = 0; elem < nelems; elem++) { dtp->u.p.item_count++; ! list_formatted_write_scalar (dtp, type, tmp + elem * stride, kind, size); } } *************** list_formatted_write (st_parameter_dt *d *** 844,849 **** --- 1137,1187 ---- #define NML_DIGITS 20 + static void + namelist_write_newline (st_parameter_dt *dtp) + { + if (!is_internal_unit (dtp)) + { + #ifdef HAVE_CRLF + write_character (dtp, "\r\n", 1, 2); + #else + write_character (dtp, "\n", 1, 1); + #endif + return; + } + + if (is_array_io (dtp)) + { + gfc_offset record; + int finished, length; + + length = (int) dtp->u.p.current_unit->bytes_left; + + /* Now that the current record has been padded out, + determine where the next record in the array is. */ + record = next_array_record (dtp, dtp->u.p.current_unit->ls, + &finished); + if (finished) + dtp->u.p.current_unit->endfile = AT_ENDFILE; + else + { + /* Now seek to this record */ + record = record * dtp->u.p.current_unit->recl; + + if (sseek (dtp->u.p.current_unit->s, record) == FAILURE) + { + generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); + return; + } + + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; + } + } + else + write_character (dtp, " ", 1, 1); + } + + static namelist_info * nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, namelist_info * base, char * base_name) *************** nml_write_obj (st_parameter_dt *dtp, nam *** 869,885 **** size_t base_var_name_len; size_t tot_len; unit_delim tmp_delim; /* Write namelist variable names in upper case. If a derived type, nothing is output. If a component, base and base_name are set. */ if (obj->type != GFC_DTYPE_DERIVED) { ! #ifdef HAVE_CRLF ! write_character (dtp, "\r\n ", 3); ! #else ! write_character (dtp, "\n ", 2); ! #endif len = 0; if (base) { --- 1207,1227 ---- size_t base_var_name_len; size_t tot_len; unit_delim tmp_delim; + + /* Set the character to be used to separate values + to a comma or semi-colon. */ + + char semi_comma = + dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? ',' : ';'; /* Write namelist variable names in upper case. If a derived type, nothing is output. If a component, base and base_name are set. */ if (obj->type != GFC_DTYPE_DERIVED) { ! namelist_write_newline (dtp); ! write_character (dtp, " ", 1, 1); ! len = 0; if (base) { *************** nml_write_obj (st_parameter_dt *dtp, nam *** 887,901 **** for (dim_i = 0; dim_i < (index_type) strlen (base_name); dim_i++) { cup = toupper (base_name[dim_i]); ! write_character (dtp, &cup, 1); } } for (dim_i =len; dim_i < (index_type) strlen (obj->var_name); dim_i++) { cup = toupper (obj->var_name[dim_i]); ! write_character (dtp, &cup, 1); } ! write_character (dtp, "=", 1); } /* Counts the number of data output on a line, including names. */ --- 1229,1243 ---- for (dim_i = 0; dim_i < (index_type) strlen (base_name); dim_i++) { cup = toupper (base_name[dim_i]); ! write_character (dtp, &cup, 1, 1); } } for (dim_i =len; dim_i < (index_type) strlen (obj->var_name); dim_i++) { cup = toupper (obj->var_name[dim_i]); ! write_character (dtp, &cup, 1, 1); } ! write_character (dtp, "=", 1, 1); } /* Counts the number of data output on a line, including names. */ *************** nml_write_obj (st_parameter_dt *dtp, nam *** 965,971 **** if (rep_ctr > 1) { sprintf(rep_buff, " %d*", rep_ctr); ! write_character (dtp, rep_buff, strlen (rep_buff)); dtp->u.p.no_leading_blank = 1; } num++; --- 1307,1313 ---- if (rep_ctr > 1) { sprintf(rep_buff, " %d*", rep_ctr); ! write_character (dtp, rep_buff, 1, strlen (rep_buff)); dtp->u.p.no_leading_blank = 1; } num++; *************** nml_write_obj (st_parameter_dt *dtp, nam *** 985,1004 **** break; case GFC_DTYPE_CHARACTER: ! tmp_delim = dtp->u.p.current_unit->flags.delim; if (dtp->u.p.nml_delim == '"') ! dtp->u.p.current_unit->flags.delim = DELIM_QUOTE; if (dtp->u.p.nml_delim == '\'') ! dtp->u.p.current_unit->flags.delim = DELIM_APOSTROPHE; ! write_character (dtp, p, obj->string_length); ! dtp->u.p.current_unit->flags.delim = tmp_delim; break; case GFC_DTYPE_REAL: write_real (dtp, p, len); break; ! case GFC_DTYPE_COMPLEX: dtp->u.p.no_leading_blank = 0; num++; write_complex (dtp, p, len, obj_size); --- 1327,1346 ---- break; case GFC_DTYPE_CHARACTER: ! tmp_delim = dtp->u.p.current_unit->delim_status; if (dtp->u.p.nml_delim == '"') ! dtp->u.p.current_unit->delim_status = DELIM_QUOTE; if (dtp->u.p.nml_delim == '\'') ! dtp->u.p.current_unit->delim_status = DELIM_APOSTROPHE; ! write_character (dtp, p, 1, obj->string_length); ! dtp->u.p.current_unit->delim_status = tmp_delim; break; case GFC_DTYPE_REAL: write_real (dtp, p, len); break; ! case GFC_DTYPE_COMPLEX: dtp->u.p.no_leading_blank = 0; num++; write_complex (dtp, p, len, obj_size); *************** nml_write_obj (st_parameter_dt *dtp, nam *** 1075,1094 **** internal_error (&dtp->common, "Bad type for namelist write"); } ! /* Reset the leading blank suppression, write a comma and, if 5 ! values have been output, write a newline and advance to column ! 2. Reset the repeat counter. */ dtp->u.p.no_leading_blank = 0; ! write_character (dtp, ",", 1); if (num > 5) { num = 0; ! #ifdef HAVE_CRLF ! write_character (dtp, "\r\n ", 3); ! #else ! write_character (dtp, "\n ", 2); ! #endif } rep_ctr = 1; } --- 1417,1433 ---- internal_error (&dtp->common, "Bad type for namelist write"); } ! /* Reset the leading blank suppression, write a comma (or semi-colon) ! and, if 5 values have been output, write a newline and advance ! to column 2. Reset the repeat counter. */ dtp->u.p.no_leading_blank = 0; ! write_character (dtp, &semi_comma, 1, 1); if (num > 5) { num = 0; ! namelist_write_newline (dtp); ! write_character (dtp, " ", 1, 1); } rep_ctr = 1; } *************** obj_loop: *** 1115,1120 **** --- 1454,1460 ---- return retval; } + /* This is the entry function for namelist writes. It outputs the name of the namelist and iterates through the namelist by calls to nml_write_obj. The call below has dummys in the arguments used in *************** namelist_write (st_parameter_dt *dtp) *** 1128,1151 **** index_type dummy_offset = 0; char c; char * dummy_name = NULL; ! unit_delim tmp_delim; /* Set the delimiter for namelist output. */ ! ! tmp_delim = dtp->u.p.current_unit->flags.delim; dtp->u.p.nml_delim = tmp_delim == DELIM_APOSTROPHE ? '\'' : '"'; /* Temporarily disable namelist delimters. */ ! dtp->u.p.current_unit->flags.delim = DELIM_NONE; ! write_character (dtp, "&", 1); /* Write namelist name in upper case - f95 std. */ for (i = 0 ;i < dtp->namelist_name_len ;i++ ) { c = toupper (dtp->namelist_name[i]); ! write_character (dtp, &c ,1); } if (dtp->u.p.ionml != NULL) --- 1468,1490 ---- index_type dummy_offset = 0; char c; char * dummy_name = NULL; ! unit_delim tmp_delim = DELIM_UNSPECIFIED; /* Set the delimiter for namelist output. */ ! tmp_delim = dtp->u.p.current_unit->delim_status; dtp->u.p.nml_delim = tmp_delim == DELIM_APOSTROPHE ? '\'' : '"'; /* Temporarily disable namelist delimters. */ ! dtp->u.p.current_unit->delim_status = DELIM_NONE; ! write_character (dtp, "&", 1, 1); /* Write namelist name in upper case - f95 std. */ for (i = 0 ;i < dtp->namelist_name_len ;i++ ) { c = toupper (dtp->namelist_name[i]); ! write_character (dtp, &c, 1 ,1); } if (dtp->u.p.ionml != NULL) *************** namelist_write (st_parameter_dt *dtp) *** 1158,1171 **** } } ! #ifdef HAVE_CRLF ! write_character (dtp, " /\r\n", 5); ! #else ! write_character (dtp, " /\n", 4); ! #endif ! /* Restore the original delimiter. */ ! dtp->u.p.current_unit->flags.delim = tmp_delim; } #undef NML_DIGITS --- 1497,1506 ---- } } ! namelist_write_newline (dtp); ! write_character (dtp, " /", 1, 2); /* Restore the original delimiter. */ ! dtp->u.p.current_unit->delim_status = tmp_delim; } #undef NML_DIGITS diff -Nrcpad gcc-4.3.3/libgfortran/io/write_float.def gcc-4.4.0/libgfortran/io/write_float.def *** gcc-4.3.3/libgfortran/io/write_float.def Sun Oct 19 15:28:25 2008 --- gcc-4.4.0/libgfortran/io/write_float.def Thu Apr 9 23:23:07 2009 *************** *** 1,37 **** ! /* Copyright (C) 2007 Free Software Foundation, Inc. Contributed by Andy Vaught Write float code factoring to this file by Jerry DeLisle This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with Libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" typedef enum ! { SIGN_NONE, SIGN_MINUS, SIGN_PLUS } sign_t; /* Given a flag that indicates if a value is negative or not, return a --- 1,33 ---- ! /* Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught Write float code factoring to this file by Jerry DeLisle + F2003 I/O support contributed by Jerry DeLisle This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "config.h" typedef enum ! { S_NONE, S_MINUS, S_PLUS } sign_t; /* Given a flag that indicates if a value is negative or not, return a *************** sign_t; *** 40,60 **** static sign_t calculate_sign (st_parameter_dt *dtp, int negative_flag) { ! sign_t s = SIGN_NONE; if (negative_flag) ! s = SIGN_MINUS; else switch (dtp->u.p.sign_status) { ! case SIGN_SP: ! s = SIGN_PLUS; break; ! case SIGN_SS: ! s = SIGN_NONE; break; ! case SIGN_S: ! s = options.optional_plus ? SIGN_PLUS : SIGN_NONE; break; } --- 36,57 ---- static sign_t calculate_sign (st_parameter_dt *dtp, int negative_flag) { ! sign_t s = S_NONE; if (negative_flag) ! s = S_MINUS; else switch (dtp->u.p.sign_status) { ! case SIGN_SP: /* Show sign. */ ! s = S_PLUS; break; ! case SIGN_SS: /* Suppress sign. */ ! s = S_NONE; break; ! case SIGN_S: /* Processor defined. */ ! case SIGN_UNSPECIFIED: ! s = options.optional_plus ? S_PLUS : S_NONE; break; } *************** output_float (st_parameter_dt *dtp, cons *** 98,129 **** if (d < 0) internal_error (&dtp->common, "Unspecified precision"); - /* Use sprintf to print the number in the format +D.DDDDe+ddd - For an N digit exponent, this gives us (MIN_FIELD_WIDTH-5)-N digits - after the decimal point, plus another one before the decimal point. */ - sign = calculate_sign (dtp, sign_bit); ! ! /* # The result will always contain a decimal point, even if no ! * digits follow it ! * ! * - The converted value is to be left adjusted on the field boundary ! * ! * + A sign (+ or -) always be placed before a number ! * ! * MIN_FIELD_WIDTH minimum field width ! * ! * * (ndigits-1) is used as the precision ! * ! * e format: [-]d.ddde±dd where there is one digit before the ! * decimal-point character and the number of digits after it is ! * equal to the precision. The exponent always contains at least two ! * digits; if the value is zero, the exponent is 00. ! */ ! ! /* Check the given string has punctuation in the correct places. */ ! if (d != 0 && (buffer[2] != '.' || buffer[ndigits + 2] != 'e')) ! internal_error (&dtp->common, "printf is broken"); /* Read the exponent back in. */ e = atoi (&buffer[ndigits + 3]) + 1; --- 95,107 ---- if (d < 0) internal_error (&dtp->common, "Unspecified precision"); sign = calculate_sign (dtp, sign_bit); ! ! /* The following code checks the given string has punctuation in the correct ! places. Uncomment if needed for debugging. ! if (d != 0 && ((buffer[2] != '.' && buffer[2] != ',') ! || buffer[ndigits + 2] != 'e')) ! internal_error (&dtp->common, "printf is broken"); */ /* Read the exponent back in. */ e = atoi (&buffer[ndigits + 3]) + 1; *************** output_float (st_parameter_dt *dtp, cons *** 136,141 **** --- 114,135 ---- sign = calculate_sign (dtp, sign_bit); else sign = calculate_sign (dtp, 0); + + /* Handle special cases. */ + if (w == 0) + w = d + 2; + + /* For this one we choose to not output a decimal point. + F95 10.5.1.2.1 */ + if (w == 1 && ft == FMT_F) + { + out = write_block (dtp, w); + if (out == NULL) + return; + *out = '0'; + return; + } + } /* Normalize the fractional component. */ *************** output_float (st_parameter_dt *dtp, cons *** 167,172 **** --- 161,179 ---- case FMT_E: case FMT_D: i = dtp->u.p.scale_factor; + if (d <= 0 && i == 0) + { + generate_error (&dtp->common, LIBERROR_FORMAT, "Precision not " + "greater than zero in format specifier 'E' or 'D'"); + return; + } + if (i <= -d || i >= d + 2) + { + generate_error (&dtp->common, LIBERROR_FORMAT, "Scale factor " + "out of range in format specifier 'E' or 'D'"); + return; + } + if (!zero_flag) e -= i; if (i < 0) *************** output_float (st_parameter_dt *dtp, cons *** 321,335 **** else edigits = 0; - /* Pick a field size if none was specified. */ - if (w <= 0) - w = nbefore + nzero + nafter + (sign != SIGN_NONE ? 2 : 1); - - /* Create the ouput buffer. */ - out = write_block (dtp, w); - if (out == NULL) - return; - /* Zero values always output as positive, even if the value was negative before rounding. */ for (i = 0; i < ndigits; i++) --- 328,333 ---- *************** output_float (st_parameter_dt *dtp, cons *** 347,357 **** sign = calculate_sign (dtp, 0); } /* Work out how much padding is needed. */ nblanks = w - (nbefore + nzero + nafter + edigits + 1); ! if (sign != SIGN_NONE) nblanks--; /* Check the value fits in the specified field width. */ if (nblanks < 0 || edigits == -1) { --- 345,370 ---- sign = calculate_sign (dtp, 0); } + /* Pick a field size if none was specified. */ + if (w <= 0) + w = nbefore + nzero + nafter + (sign != S_NONE ? 2 : 1); + /* Work out how much padding is needed. */ nblanks = w - (nbefore + nzero + nafter + edigits + 1); ! if (sign != S_NONE) nblanks--; + if (dtp->u.p.g0_no_blanks) + { + w -= nblanks; + nblanks = 0; + } + + /* Create the ouput buffer. */ + out = write_block (dtp, w); + if (out == NULL) + return; + /* Check the value fits in the specified field width. */ if (nblanks < 0 || edigits == -1) { *************** output_float (st_parameter_dt *dtp, cons *** 377,385 **** } /* Output the initial sign (if any). */ ! if (sign == SIGN_PLUS) *(out++) = '+'; ! else if (sign == SIGN_MINUS) *(out++) = '-'; /* Output an optional leading zero. */ --- 390,398 ---- } /* Output the initial sign (if any). */ ! if (sign == S_PLUS) *(out++) = '+'; ! else if (sign == S_MINUS) *(out++) = '-'; /* Output an optional leading zero. */ *************** output_float (st_parameter_dt *dtp, cons *** 407,414 **** digits += i; out += nbefore; } /* Output the decimal point. */ ! *(out++) = '.'; /* Output leading zeros after the decimal point. */ if (nzero > 0) --- 420,428 ---- digits += i; out += nbefore; } + /* Output the decimal point. */ ! *(out++) = dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? '.' : ','; /* Output leading zeros after the decimal point. */ if (nzero > 0) *************** output_float (st_parameter_dt *dtp, cons *** 449,460 **** --- 463,476 ---- #endif memcpy (out, buffer, edigits); } + if (dtp->u.p.no_leading_blank) { out += edigits; memset( out , ' ' , nblanks ); dtp->u.p.no_leading_blank = 0; } + #undef STR #undef STR1 #undef MIN_FIELD_WIDTH *************** output_float_FMT_G_ ## x (st_parameter_d *** 594,600 **** int save_scale_factor, nb = 0;\ \ save_scale_factor = dtp->u.p.scale_factor;\ ! newf = get_mem (sizeof (fnode));\ \ exp_d = calculate_exp_ ## x (d);\ if ((m > 0.0 && m < 0.1 - 0.05 / exp_d) || (m >= exp_d - 0.5 ) ||\ --- 610,616 ---- int save_scale_factor, nb = 0;\ \ save_scale_factor = dtp->u.p.scale_factor;\ ! newf = (fnode *) get_mem (sizeof (fnode));\ \ exp_d = calculate_exp_ ## x (d);\ if ((m > 0.0 && m < 0.1 - 0.05 / exp_d) || (m >= exp_d - 0.5 ) ||\ *************** output_float_FMT_G_ ## x (st_parameter_d *** 619,626 **** GFC_REAL_ ## x temp;\ mid = (low + high) / 2;\ \ ! temp = 0.1 * calculate_exp_ ## x (mid) - 0.5\ ! * calculate_exp_ ## x (mid - d - 1);\ \ if (m < temp)\ { \ --- 635,642 ---- GFC_REAL_ ## x temp;\ mid = (low + high) / 2;\ \ ! temp = (calculate_exp_ ## x (mid) - \ ! 5 * calculate_exp_ ## x (mid - d - 1)) / 10;\ \ if (m < temp)\ { \ *************** output_float_FMT_G_ ## x (st_parameter_d *** 640,646 **** low = mid + 1;\ }\ else\ ! break;\ }\ \ if (e < 0)\ --- 656,665 ---- low = mid + 1;\ }\ else\ ! {\ ! mid++;\ ! break;\ ! }\ }\ \ if (e < 0)\ *************** output_float_FMT_G_ ## x (st_parameter_d *** 665,671 **** \ free_mem(newf);\ \ ! if (nb > 0)\ { \ p = write_block (dtp, nb);\ if (p == NULL)\ --- 684,690 ---- \ free_mem(newf);\ \ ! if (nb > 0 && !dtp->u.p.g0_no_blanks)\ { \ p = write_block (dtp, nb);\ if (p == NULL)\ *************** OUTPUT_FLOAT_FMT_G(16) *** 688,695 **** --- 707,736 ---- #undef OUTPUT_FLOAT_FMT_G + /* Define a macro to build code for write_float. */ + /* Note: Before output_float is called, sprintf is used to print to buffer the + number in the format +D.DDDDe+ddd. For an N digit exponent, this gives us + (MIN_FIELD_WIDTH-5)-N digits after the decimal point, plus another one + before the decimal point. + + # The result will always contain a decimal point, even if no + digits follow it + + - The converted value is to be left adjusted on the field boundary + + + A sign (+ or -) always be placed before a number + + MIN_FIELD_WIDTH minimum field width + + * (ndigits-1) is used as the precision + + e format: [-]d.ddde±dd where there is one digit before the + decimal-point character and the number of digits after it is + equal to the precision. The exponent always contains at least two + digits; if the value is zero, the exponent is 00. */ + #ifdef HAVE_SNPRINTF #define DTOA \ *************** sprintf (buffer, "%+-#" STR(MIN_FIELD_WI *** 723,729 **** return;\ }\ tmp = sign_bit ? -tmp : tmp;\ ! if (f->u.real.d == 0 && f->format == FMT_F)\ {\ if (tmp < 0.5)\ tmp = 0.0;\ --- 764,771 ---- return;\ }\ tmp = sign_bit ? -tmp : tmp;\ ! if (f->u.real.d == 0 && f->format == FMT_F\ ! && dtp->u.p.scale_factor == 0)\ {\ if (tmp < 0.5)\ tmp = 0.0;\ diff -Nrcpad gcc-4.3.3/libgfortran/libgfortran.h gcc-4.4.0/libgfortran/libgfortran.h *** gcc-4.3.3/libgfortran/libgfortran.h Thu Oct 25 23:32:07 2007 --- gcc-4.4.0/libgfortran/libgfortran.h Thu Apr 9 23:23:07 2009 *************** *** 1,32 **** /* Common declarations for all of libgfortran. ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook , and Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). ! Libgfortran is free software; you can redistribute it and/or ! modify it under the terms of the GNU Lesser General Public ! License as published by the Free Software Foundation; either ! version 2.1 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Lesser General Public License for more details. ! ! You should have received a copy of the GNU Lesser General Public ! License along with libgfor; see the file COPYING.LIB. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ ! /* As a special exception, if you link this library with other files, ! some of which are compiled with GCC, to produce an executable, ! this library does not by itself cause the resulting executable ! to be covered by the GNU General Public License. ! This exception does not however invalidate any other reasons why ! the executable file might be covered by the GNU General Public License. */ #ifndef LIBGFOR_H #define LIBGFOR_H --- 1,29 ---- /* Common declarations for all of libgfortran. ! Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 ! Free Software Foundation, Inc. Contributed by Paul Brook , and Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). ! Libgfortran is free software; you can redistribute it and/or modify ! it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) ! any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ #ifndef LIBGFOR_H #define LIBGFOR_H *************** typedef off_t gfc_offset; *** 67,72 **** --- 64,106 ---- #ifndef __GNUC__ #define __attribute__(x) + #define likely(x) (x) + #define unlikely(x) (x) + #else + #define likely(x) __builtin_expect(!!(x), 1) + #define unlikely(x) __builtin_expect(!!(x), 0) + #endif + + + /* We use intptr_t and uintptr_t, which may not be always defined in + system headers. */ + + #ifndef HAVE_INTPTR_T + #if __SIZEOF_POINTER__ == __SIZEOF_LONG__ + #define intptr_t long + #elif __SIZEOF_POINTER__ == __SIZEOF_LONG_LONG__ + #define intptr_t long long + #elif __SIZEOF_POINTER__ == __SIZEOF_INT__ + #define intptr_t int + #elif __SIZEOF_POINTER__ == __SIZEOF_SHORT__ + #define intptr_t short + #else + #error "Pointer type with unexpected size" + #endif + #endif + + #ifndef HAVE_UINTPTR_T + #if __SIZEOF_POINTER__ == __SIZEOF_LONG__ + #define uintptr_t unsigned long + #elif __SIZEOF_POINTER__ == __SIZEOF_LONG_LONG__ + #define uintptr_t unsigned long long + #elif __SIZEOF_POINTER__ == __SIZEOF_INT__ + #define uintptr_t unsigned int + #elif __SIZEOF_POINTER__ == __SIZEOF_SHORT__ + #define uintptr_t unsigned short + #else + #error "Pointer type with unexpected size" + #endif #endif *************** typedef off_t gfc_offset; *** 74,80 **** mingw provides, __mingw_snprintf(). We also provide a prototype for __mingw_snprintf(), because the mingw headers currently don't have one. */ #if HAVE_MINGW_SNPRINTF ! extern int __mingw_snprintf (char *, size_t, const char *, ...); #undef snprintf #define snprintf __mingw_snprintf #endif --- 108,115 ---- mingw provides, __mingw_snprintf(). We also provide a prototype for __mingw_snprintf(), because the mingw headers currently don't have one. */ #if HAVE_MINGW_SNPRINTF ! extern int __mingw_snprintf (char *, size_t, const char *, ...) ! __attribute__ ((format (gnu_printf, 3, 4))); #undef snprintf #define snprintf __mingw_snprintf #endif *************** typedef GFC_INTEGER_4 GFC_IO_INT; *** 226,240 **** by the compiler. */ /* The type used of array indices, amongst other things. */ typedef ssize_t index_type; /* The type used for the lengths of character variables. */ typedef GFC_INTEGER_4 gfc_charlen_type; /* This will be 0 on little-endian machines and one on big-endian machines. */ ! extern int l8_to_l4_offset; ! internal_proto(l8_to_l4_offset); #define GFOR_POINTER_TO_L1(p, kind) \ ! (l8_to_l4_offset * (kind - 1) + (GFC_LOGICAL_1 *)(p)) #define GFC_INTEGER_1_HUGE \ (GFC_INTEGER_1)((((GFC_UINTEGER_1)1) << 7) - 1) --- 261,285 ---- by the compiler. */ /* The type used of array indices, amongst other things. */ typedef ssize_t index_type; + /* The type used for the lengths of character variables. */ typedef GFC_INTEGER_4 gfc_charlen_type; + /* Definitions of CHARACTER data types: + - CHARACTER(KIND=1) corresponds to the C char type, + - CHARACTER(KIND=4) corresponds to an unsigned 32-bit integer. */ + typedef GFC_UINTEGER_4 gfc_char4_t; + + /* Byte size of character kinds. For the kinds currently supported, it's + simply equal to the kind parameter itself. */ + #define GFC_SIZE_OF_CHAR_KIND(kind) (kind) + /* This will be 0 on little-endian machines and one on big-endian machines. */ ! extern int big_endian; ! internal_proto(big_endian); #define GFOR_POINTER_TO_L1(p, kind) \ ! (big_endian * (kind - 1) + (GFC_LOGICAL_1 *)(p)) #define GFC_INTEGER_1_HUGE \ (GFC_INTEGER_1)((((GFC_UINTEGER_1)1) << 7) - 1) *************** typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DI *** 308,313 **** --- 353,450 ---- #define GFC_DESCRIPTOR_DATA(desc) ((desc)->data) #define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype) + /* Macros to get both the size and the type with a single masking operation */ + + #define GFC_DTYPE_SIZE_MASK \ + ((~((index_type) 0) >> GFC_DTYPE_SIZE_SHIFT) << GFC_DTYPE_SIZE_SHIFT) + #define GFC_DTYPE_TYPE_SIZE_MASK (GFC_DTYPE_SIZE_MASK | GFC_DTYPE_TYPE_MASK) + + #define GFC_DTYPE_TYPE_SIZE(desc) ((desc)->dtype & GFC_DTYPE_TYPE_SIZE_MASK) + + #define GFC_DTYPE_INTEGER_1 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT)) + #define GFC_DTYPE_INTEGER_2 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT)) + #define GFC_DTYPE_INTEGER_4 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT)) + #define GFC_DTYPE_INTEGER_8 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT)) + #ifdef HAVE_GFC_INTEGER_16 + #define GFC_DTYPE_INTEGER_16 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT)) + #endif + + #define GFC_DTYPE_LOGICAL_1 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_LOGICAL_1) << GFC_DTYPE_SIZE_SHIFT)) + #define GFC_DTYPE_LOGICAL_2 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_LOGICAL_2) << GFC_DTYPE_SIZE_SHIFT)) + #define GFC_DTYPE_LOGICAL_4 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_LOGICAL_4) << GFC_DTYPE_SIZE_SHIFT)) + #define GFC_DTYPE_LOGICAL_8 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_LOGICAL_8) << GFC_DTYPE_SIZE_SHIFT)) + #ifdef HAVE_GFC_LOGICAL_16 + #define GFC_DTYPE_LOGICAL_16 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_LOGICAL_16) << GFC_DTYPE_SIZE_SHIFT)) + #endif + + #define GFC_DTYPE_REAL_4 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_REAL_4) << GFC_DTYPE_SIZE_SHIFT)) + #define GFC_DTYPE_REAL_8 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_REAL_8) << GFC_DTYPE_SIZE_SHIFT)) + #ifdef HAVE_GFC_REAL_10 + #define GFC_DTYPE_REAL_10 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_REAL_10) << GFC_DTYPE_SIZE_SHIFT)) + #endif + #ifdef HAVE_GFC_REAL_16 + #define GFC_DTYPE_REAL_16 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_REAL_16) << GFC_DTYPE_SIZE_SHIFT)) + #endif + + #define GFC_DTYPE_COMPLEX_4 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_COMPLEX_4) << GFC_DTYPE_SIZE_SHIFT)) + #define GFC_DTYPE_COMPLEX_8 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_COMPLEX_8) << GFC_DTYPE_SIZE_SHIFT)) + #ifdef HAVE_GFC_COMPLEX_10 + #define GFC_DTYPE_COMPLEX_10 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_COMPLEX_10) << GFC_DTYPE_SIZE_SHIFT)) + #endif + #ifdef HAVE_GFC_COMPLEX_16 + #define GFC_DTYPE_COMPLEX_16 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_COMPLEX_16) << GFC_DTYPE_SIZE_SHIFT)) + #endif + + #define GFC_DTYPE_DERIVED_1 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT)) + #define GFC_DTYPE_DERIVED_2 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT)) + #define GFC_DTYPE_DERIVED_4 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT)) + #define GFC_DTYPE_DERIVED_8 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT)) + #ifdef HAVE_GFC_INTEGER_16 + #define GFC_DTYPE_DERIVED_16 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT)) + #endif + + /* Macros to determine the alignment of pointers. */ + + #define GFC_UNALIGNED_2(x) (((uintptr_t)(x)) & \ + (__alignof__(GFC_INTEGER_2) - 1)) + #define GFC_UNALIGNED_4(x) (((uintptr_t)(x)) & \ + (__alignof__(GFC_INTEGER_4) - 1)) + #define GFC_UNALIGNED_8(x) (((uintptr_t)(x)) & \ + (__alignof__(GFC_INTEGER_8) - 1)) + #ifdef HAVE_GFC_INTEGER_16 + #define GFC_UNALIGNED_16(x) (((uintptr_t)(x)) & \ + (__alignof__(GFC_INTEGER_16) - 1)) + #endif + + #define GFC_UNALIGNED_C4(x) (((uintptr_t)(x)) & \ + (__alignof__(GFC_COMPLEX_4) - 1)) + + #define GFC_UNALIGNED_C8(x) (((uintptr_t)(x)) & \ + (__alignof__(GFC_COMPLEX_8) - 1)) + /* Runtime library include. */ #define stringize(x) expand_macro(x) #define expand_macro(x) # x *************** typedef struct *** 348,353 **** --- 485,491 ---- size_t record_marker; int max_subrecord_length; int bounds_check; + int range_check; } compile_options_t; *************** st_parameter_common; *** 447,452 **** --- 585,595 ---- #define IOPARM_OPEN_HAS_DELIM (1 << 15) #define IOPARM_OPEN_HAS_PAD (1 << 16) #define IOPARM_OPEN_HAS_CONVERT (1 << 17) + #define IOPARM_OPEN_HAS_DECIMAL (1 << 18) + #define IOPARM_OPEN_HAS_ENCODING (1 << 19) + #define IOPARM_OPEN_HAS_ROUND (1 << 20) + #define IOPARM_OPEN_HAS_SIGN (1 << 21) + #define IOPARM_OPEN_HAS_ASYNCHRONOUS (1 << 22) /* library start function and end macro. These can be expanded if needed in the future. cmp is st_parameter_common *cmp */ *************** extern void runtime_error_at (const char *** 508,513 **** --- 651,660 ---- __attribute__ ((noreturn, format (printf, 2, 3))); iexport_proto(runtime_error_at); + extern void runtime_warning_at (const char *, const char *, ...) + __attribute__ ((format (printf, 2, 3))); + iexport_proto(runtime_warning_at); + extern void internal_error (st_parameter_common *, const char *) __attribute__ ((noreturn)); internal_proto(internal_error); *************** extern void reshape_packed (char *, inde *** 609,618 **** const char *, index_type); internal_proto(reshape_packed); ! /* Repacking functions. */ - /* ??? These aren't currently used by the compiler, though we - certainly could do so. */ GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *); internal_proto(internal_pack_4); --- 756,770 ---- const char *, index_type); internal_proto(reshape_packed); ! /* Repacking functions. These are called internally by internal_pack ! and internal_unpack. */ ! ! GFC_INTEGER_1 *internal_pack_1 (gfc_array_i1 *); ! internal_proto(internal_pack_1); ! ! GFC_INTEGER_2 *internal_pack_2 (gfc_array_i2 *); ! internal_proto(internal_pack_2); GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *); internal_proto(internal_pack_4); *************** GFC_INTEGER_16 *internal_pack_16 (gfc_ar *** 624,629 **** --- 776,797 ---- internal_proto(internal_pack_16); #endif + GFC_REAL_4 *internal_pack_r4 (gfc_array_r4 *); + internal_proto(internal_pack_r4); + + GFC_REAL_8 *internal_pack_r8 (gfc_array_r8 *); + internal_proto(internal_pack_r8); + + #if defined HAVE_GFC_REAL_10 + GFC_REAL_10 *internal_pack_r10 (gfc_array_r10 *); + internal_proto(internal_pack_r10); + #endif + + #if defined HAVE_GFC_REAL_16 + GFC_REAL_16 *internal_pack_r16 (gfc_array_r16 *); + internal_proto(internal_pack_r16); + #endif + GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *); internal_proto(internal_pack_c4); *************** GFC_COMPLEX_10 *internal_pack_c10 (gfc_a *** 635,640 **** --- 803,819 ---- internal_proto(internal_pack_c10); #endif + #if defined HAVE_GFC_COMPLEX_16 + GFC_COMPLEX_16 *internal_pack_c16 (gfc_array_c16 *); + internal_proto(internal_pack_c16); + #endif + + extern void internal_unpack_1 (gfc_array_i1 *, const GFC_INTEGER_1 *); + internal_proto(internal_unpack_1); + + extern void internal_unpack_2 (gfc_array_i2 *, const GFC_INTEGER_2 *); + internal_proto(internal_unpack_2); + extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *); internal_proto(internal_unpack_4); *************** extern void internal_unpack_16 (gfc_arra *** 646,651 **** --- 825,846 ---- internal_proto(internal_unpack_16); #endif + extern void internal_unpack_r4 (gfc_array_r4 *, const GFC_REAL_4 *); + internal_proto(internal_unpack_r4); + + extern void internal_unpack_r8 (gfc_array_r8 *, const GFC_REAL_8 *); + internal_proto(internal_unpack_r8); + + #if defined HAVE_GFC_REAL_10 + extern void internal_unpack_r10 (gfc_array_r10 *, const GFC_REAL_10 *); + internal_proto(internal_unpack_r10); + #endif + + #if defined HAVE_GFC_REAL_16 + extern void internal_unpack_r16 (gfc_array_r16 *, const GFC_REAL_16 *); + internal_proto(internal_unpack_r16); + #endif + extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *); internal_proto(internal_unpack_c4); *************** extern void internal_unpack_c16 (gfc_arr *** 662,673 **** internal_proto(internal_unpack_c16); #endif /* string_intrinsics.c */ ! extern int compare_string (GFC_INTEGER_4, const char *, ! GFC_INTEGER_4, const char *); iexport_proto(compare_string); /* random.c */ extern void random_seed_i4 (GFC_INTEGER_4 * size, gfc_array_i4 * put, --- 857,1208 ---- internal_proto(internal_unpack_c16); #endif + /* Internal auxiliary functions for the pack intrinsic. */ + + extern void pack_i1 (gfc_array_i1 *, const gfc_array_i1 *, + const gfc_array_l1 *, const gfc_array_i1 *); + internal_proto(pack_i1); + + extern void pack_i2 (gfc_array_i2 *, const gfc_array_i2 *, + const gfc_array_l1 *, const gfc_array_i2 *); + internal_proto(pack_i2); + + extern void pack_i4 (gfc_array_i4 *, const gfc_array_i4 *, + const gfc_array_l1 *, const gfc_array_i4 *); + internal_proto(pack_i4); + + extern void pack_i8 (gfc_array_i8 *, const gfc_array_i8 *, + const gfc_array_l1 *, const gfc_array_i8 *); + internal_proto(pack_i8); + + #ifdef HAVE_GFC_INTEGER_16 + extern void pack_i16 (gfc_array_i16 *, const gfc_array_i16 *, + const gfc_array_l1 *, const gfc_array_i16 *); + internal_proto(pack_i16); + #endif + + extern void pack_r4 (gfc_array_r4 *, const gfc_array_r4 *, + const gfc_array_l1 *, const gfc_array_r4 *); + internal_proto(pack_r4); + + extern void pack_r8 (gfc_array_r8 *, const gfc_array_r8 *, + const gfc_array_l1 *, const gfc_array_r8 *); + internal_proto(pack_r8); + + #ifdef HAVE_GFC_REAL_10 + extern void pack_r10 (gfc_array_r10 *, const gfc_array_r10 *, + const gfc_array_l1 *, const gfc_array_r10 *); + internal_proto(pack_r10); + #endif + + #ifdef HAVE_GFC_REAL_16 + extern void pack_r16 (gfc_array_r16 *, const gfc_array_r16 *, + const gfc_array_l1 *, const gfc_array_r16 *); + internal_proto(pack_r16); + #endif + + extern void pack_c4 (gfc_array_c4 *, const gfc_array_c4 *, + const gfc_array_l1 *, const gfc_array_c4 *); + internal_proto(pack_c4); + + extern void pack_c8 (gfc_array_c8 *, const gfc_array_c8 *, + const gfc_array_l1 *, const gfc_array_c8 *); + internal_proto(pack_c8); + + #ifdef HAVE_GFC_REAL_10 + extern void pack_c10 (gfc_array_c10 *, const gfc_array_c10 *, + const gfc_array_l1 *, const gfc_array_c10 *); + internal_proto(pack_c10); + #endif + + #ifdef HAVE_GFC_REAL_16 + extern void pack_c16 (gfc_array_c16 *, const gfc_array_c16 *, + const gfc_array_l1 *, const gfc_array_c16 *); + internal_proto(pack_c16); + #endif + + /* Internal auxiliary functions for the unpack intrinsic. */ + + extern void unpack0_i1 (gfc_array_i1 *, const gfc_array_i1 *, + const gfc_array_l1 *, const GFC_INTEGER_1 *); + internal_proto(unpack0_i1); + + extern void unpack0_i2 (gfc_array_i2 *, const gfc_array_i2 *, + const gfc_array_l1 *, const GFC_INTEGER_2 *); + internal_proto(unpack0_i2); + + extern void unpack0_i4 (gfc_array_i4 *, const gfc_array_i4 *, + const gfc_array_l1 *, const GFC_INTEGER_4 *); + internal_proto(unpack0_i4); + + extern void unpack0_i8 (gfc_array_i8 *, const gfc_array_i8 *, + const gfc_array_l1 *, const GFC_INTEGER_8 *); + internal_proto(unpack0_i8); + + #ifdef HAVE_GFC_INTEGER_16 + + extern void unpack0_i16 (gfc_array_i16 *, const gfc_array_i16 *, + const gfc_array_l1 *, const GFC_INTEGER_16 *); + internal_proto(unpack0_i16); + + #endif + + extern void unpack0_r4 (gfc_array_r4 *, const gfc_array_r4 *, + const gfc_array_l1 *, const GFC_REAL_4 *); + internal_proto(unpack0_r4); + + extern void unpack0_r8 (gfc_array_r8 *, const gfc_array_r8 *, + const gfc_array_l1 *, const GFC_REAL_8 *); + internal_proto(unpack0_r8); + + #ifdef HAVE_GFC_REAL_10 + + extern void unpack0_r10 (gfc_array_r10 *, const gfc_array_r10 *, + const gfc_array_l1 *, const GFC_REAL_10 *); + internal_proto(unpack0_r10); + + #endif + + #ifdef HAVE_GFC_REAL_16 + + extern void unpack0_r16 (gfc_array_r16 *, const gfc_array_r16 *, + const gfc_array_l1 *, const GFC_REAL_16 *); + internal_proto(unpack0_r16); + + #endif + + extern void unpack0_c4 (gfc_array_c4 *, const gfc_array_c4 *, + const gfc_array_l1 *, const GFC_COMPLEX_4 *); + internal_proto(unpack0_c4); + + extern void unpack0_c8 (gfc_array_c8 *, const gfc_array_c8 *, + const gfc_array_l1 *, const GFC_COMPLEX_8 *); + internal_proto(unpack0_c8); + + #ifdef HAVE_GFC_COMPLEX_10 + + extern void unpack0_c10 (gfc_array_c10 *, const gfc_array_c10 *, + const gfc_array_l1 *mask, const GFC_COMPLEX_10 *); + internal_proto(unpack0_c10); + + #endif + + #ifdef HAVE_GFC_COMPLEX_16 + + extern void unpack0_c16 (gfc_array_c16 *, const gfc_array_c16 *, + const gfc_array_l1 *, const GFC_COMPLEX_16 *); + internal_proto(unpack0_c16); + + #endif + + extern void unpack1_i1 (gfc_array_i1 *, const gfc_array_i1 *, + const gfc_array_l1 *, const gfc_array_i1 *); + internal_proto(unpack1_i1); + + extern void unpack1_i2 (gfc_array_i2 *, const gfc_array_i2 *, + const gfc_array_l1 *, const gfc_array_i2 *); + internal_proto(unpack1_i2); + + extern void unpack1_i4 (gfc_array_i4 *, const gfc_array_i4 *, + const gfc_array_l1 *, const gfc_array_i4 *); + internal_proto(unpack1_i4); + + extern void unpack1_i8 (gfc_array_i8 *, const gfc_array_i8 *, + const gfc_array_l1 *, const gfc_array_i8 *); + internal_proto(unpack1_i8); + + #ifdef HAVE_GFC_INTEGER_16 + extern void unpack1_i16 (gfc_array_i16 *, const gfc_array_i16 *, + const gfc_array_l1 *, const gfc_array_i16 *); + internal_proto(unpack1_i16); + #endif + + extern void unpack1_r4 (gfc_array_r4 *, const gfc_array_r4 *, + const gfc_array_l1 *, const gfc_array_r4 *); + internal_proto(unpack1_r4); + + extern void unpack1_r8 (gfc_array_r8 *, const gfc_array_r8 *, + const gfc_array_l1 *, const gfc_array_r8 *); + internal_proto(unpack1_r8); + + #ifdef HAVE_GFC_REAL_10 + extern void unpack1_r10 (gfc_array_r10 *, const gfc_array_r10 *, + const gfc_array_l1 *, const gfc_array_r10 *); + internal_proto(unpack1_r10); + #endif + + #ifdef HAVE_GFC_REAL_16 + extern void unpack1_r16 (gfc_array_r16 *, const gfc_array_r16 *, + const gfc_array_l1 *, const gfc_array_r16 *); + internal_proto(unpack1_r16); + #endif + + extern void unpack1_c4 (gfc_array_c4 *, const gfc_array_c4 *, + const gfc_array_l1 *, const gfc_array_c4 *); + internal_proto(unpack1_c4); + + extern void unpack1_c8 (gfc_array_c8 *, const gfc_array_c8 *, + const gfc_array_l1 *, const gfc_array_c8 *); + internal_proto(unpack1_c8); + + #ifdef HAVE_GFC_COMPLEX_10 + extern void unpack1_c10 (gfc_array_c10 *, const gfc_array_c10 *, + const gfc_array_l1 *, const gfc_array_c10 *); + internal_proto(unpack1_c10); + #endif + + #ifdef HAVE_GFC_COMPLEX_16 + extern void unpack1_c16 (gfc_array_c16 *, const gfc_array_c16 *, + const gfc_array_l1 *, const gfc_array_c16 *); + internal_proto(unpack1_c16); + #endif + + /* Helper functions for spread. */ + + extern void spread_i1 (gfc_array_i1 *, const gfc_array_i1 *, + const index_type, const index_type); + internal_proto(spread_i1); + + extern void spread_i2 (gfc_array_i2 *, const gfc_array_i2 *, + const index_type, const index_type); + internal_proto(spread_i2); + + extern void spread_i4 (gfc_array_i4 *, const gfc_array_i4 *, + const index_type, const index_type); + internal_proto(spread_i4); + + extern void spread_i8 (gfc_array_i8 *, const gfc_array_i8 *, + const index_type, const index_type); + internal_proto(spread_i8); + + #ifdef HAVE_GFC_INTEGER_16 + extern void spread_i16 (gfc_array_i16 *, const gfc_array_i16 *, + const index_type, const index_type); + internal_proto(spread_i16); + + #endif + + extern void spread_r4 (gfc_array_r4 *, const gfc_array_r4 *, + const index_type, const index_type); + internal_proto(spread_r4); + + extern void spread_r8 (gfc_array_r8 *, const gfc_array_r8 *, + const index_type, const index_type); + internal_proto(spread_r8); + + #ifdef HAVE_GFC_REAL_10 + extern void spread_r10 (gfc_array_r10 *, const gfc_array_r10 *, + const index_type, const index_type); + internal_proto(spread_r10); + + #endif + + #ifdef HAVE_GFC_REAL_16 + extern void spread_r16 (gfc_array_r16 *, const gfc_array_r16 *, + const index_type, const index_type); + internal_proto(spread_r16); + + #endif + + extern void spread_c4 (gfc_array_c4 *, const gfc_array_c4 *, + const index_type, const index_type); + internal_proto(spread_c4); + + extern void spread_c8 (gfc_array_c8 *, const gfc_array_c8 *, + const index_type, const index_type); + internal_proto(spread_c8); + + #ifdef HAVE_GFC_COMPLEX_10 + extern void spread_c10 (gfc_array_c10 *, const gfc_array_c10 *, + const index_type, const index_type); + internal_proto(spread_c10); + + #endif + + #ifdef HAVE_GFC_COMPLEX_16 + extern void spread_c16 (gfc_array_c16 *, const gfc_array_c16 *, + const index_type, const index_type); + internal_proto(spread_c16); + + #endif + + extern void spread_scalar_i1 (gfc_array_i1 *, const GFC_INTEGER_1 *, + const index_type, const index_type); + internal_proto(spread_scalar_i1); + + extern void spread_scalar_i2 (gfc_array_i2 *, const GFC_INTEGER_2 *, + const index_type, const index_type); + internal_proto(spread_scalar_i2); + + extern void spread_scalar_i4 (gfc_array_i4 *, const GFC_INTEGER_4 *, + const index_type, const index_type); + internal_proto(spread_scalar_i4); + + extern void spread_scalar_i8 (gfc_array_i8 *, const GFC_INTEGER_8 *, + const index_type, const index_type); + internal_proto(spread_scalar_i8); + + #ifdef HAVE_GFC_INTEGER_16 + extern void spread_scalar_i16 (gfc_array_i16 *, const GFC_INTEGER_16 *, + const index_type, const index_type); + internal_proto(spread_scalar_i16); + + #endif + + extern void spread_scalar_r4 (gfc_array_r4 *, const GFC_REAL_4 *, + const index_type, const index_type); + internal_proto(spread_scalar_r4); + + extern void spread_scalar_r8 (gfc_array_r8 *, const GFC_REAL_8 *, + const index_type, const index_type); + internal_proto(spread_scalar_r8); + + #ifdef HAVE_GFC_REAL_10 + extern void spread_scalar_r10 (gfc_array_r10 *, const GFC_REAL_10 *, + const index_type, const index_type); + internal_proto(spread_scalar_r10); + + #endif + + #ifdef HAVE_GFC_REAL_16 + extern void spread_scalar_r16 (gfc_array_r16 *, const GFC_REAL_16 *, + const index_type, const index_type); + internal_proto(spread_scalar_r16); + + #endif + + extern void spread_scalar_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *, + const index_type, const index_type); + internal_proto(spread_scalar_c4); + + extern void spread_scalar_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *, + const index_type, const index_type); + internal_proto(spread_scalar_c8); + + #ifdef HAVE_GFC_COMPLEX_10 + extern void spread_scalar_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *, + const index_type, const index_type); + internal_proto(spread_scalar_c10); + + #endif + + #ifdef HAVE_GFC_COMPLEX_16 + extern void spread_scalar_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *, + const index_type, const index_type); + internal_proto(spread_scalar_c16); + + #endif + /* string_intrinsics.c */ ! extern int compare_string (gfc_charlen_type, const char *, ! gfc_charlen_type, const char *); iexport_proto(compare_string); + extern int compare_string_char4 (gfc_charlen_type, const gfc_char4_t *, + gfc_charlen_type, const gfc_char4_t *); + iexport_proto(compare_string_char4); + /* random.c */ extern void random_seed_i4 (GFC_INTEGER_4 * size, gfc_array_i4 * put, *************** typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DI *** 684,687 **** --- 1219,1273 ---- extern index_type size0 (const array_t * array); iexport_proto(size0); + /* Internal auxiliary functions for cshift */ + + void cshift0_i1 (gfc_array_i1 *, const gfc_array_i1 *, ssize_t, int); + internal_proto(cshift0_i1); + + void cshift0_i2 (gfc_array_i2 *, const gfc_array_i2 *, ssize_t, int); + internal_proto(cshift0_i2); + + void cshift0_i4 (gfc_array_i4 *, const gfc_array_i4 *, ssize_t, int); + internal_proto(cshift0_i4); + + void cshift0_i8 (gfc_array_i8 *, const gfc_array_i8 *, ssize_t, int); + internal_proto(cshift0_i8); + + #ifdef HAVE_GFC_INTEGER_16 + void cshift0_i16 (gfc_array_i16 *, const gfc_array_i16 *, ssize_t, int); + internal_proto(cshift0_i16); + #endif + + void cshift0_r4 (gfc_array_r4 *, const gfc_array_r4 *, ssize_t, int); + internal_proto(cshift0_r4); + + void cshift0_r8 (gfc_array_r8 *, const gfc_array_r8 *, ssize_t, int); + internal_proto(cshift0_r8); + + #ifdef HAVE_GFC_REAL_10 + void cshift0_r10 (gfc_array_r10 *, const gfc_array_r10 *, ssize_t, int); + internal_proto(cshift0_r10); + #endif + + #ifdef HAVE_GFC_REAL_16 + void cshift0_r16 (gfc_array_r16 *, const gfc_array_r16 *, ssize_t, int); + internal_proto(cshift0_r16); + #endif + + void cshift0_c4 (gfc_array_c4 *, const gfc_array_c4 *, ssize_t, int); + internal_proto(cshift0_c4); + + void cshift0_c8 (gfc_array_c8 *, const gfc_array_c8 *, ssize_t, int); + internal_proto(cshift0_c8); + + #ifdef HAVE_GFC_COMPLEX_10 + void cshift0_c10 (gfc_array_c10 *, const gfc_array_c10 *, ssize_t, int); + internal_proto(cshift0_c10); + #endif + + #ifdef HAVE_GFC_COMPLEX_16 + void cshift0_c16 (gfc_array_c16 *, const gfc_array_c16 *, ssize_t, int); + internal_proto(cshift0_c16); + #endif + #endif /* LIBGFOR_H */ diff -Nrcpad gcc-4.3.3/libgfortran/m4/all.m4 gcc-4.4.0/libgfortran/m4/all.m4 *** gcc-4.3.3/libgfortran/m4/all.m4 Tue Jan 15 21:22:07 2008 --- gcc-4.4.0/libgfortran/m4/all.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the ALL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the ALL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/m4/any.m4 gcc-4.4.0/libgfortran/m4/any.m4 *** gcc-4.3.3/libgfortran/m4/any.m4 Tue Jan 15 21:22:07 2008 --- gcc-4.4.0/libgfortran/m4/any.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the ANY intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the ANY intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/m4/count.m4 gcc-4.4.0/libgfortran/m4/count.m4 *** gcc-4.3.3/libgfortran/m4/count.m4 Tue Jan 15 21:22:07 2008 --- gcc-4.4.0/libgfortran/m4/count.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the COUNT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the COUNT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/m4/cshift0.m4 gcc-4.4.0/libgfortran/m4/cshift0.m4 *** gcc-4.3.3/libgfortran/m4/cshift0.m4 Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/m4/cshift0.m4 Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,172 ---- + `/* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include ' + + include(iparm.m4)dnl + + `#if defined (HAVE_'rtype_name`) + + void + cshift0_'rtype_code` ('rtype` *ret, const 'rtype` *array, ssize_t shift, + int which) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + 'rtype_name` *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const 'rtype_name` *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride; + if (roffset == 0) + roffset = 1; + soffset = array->dim[dim].stride; + if (soffset == 0) + soffset = 1; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride; + sstride[n] = array->dim[dim].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof ('rtype_name`); + size_t len2 = (len - shift) * sizeof ('rtype_name`); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + 'rtype_name` *dest = rptr; + const 'rtype_name` *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; + } + + #endif' diff -Nrcpad gcc-4.3.3/libgfortran/m4/cshift1.m4 gcc-4.4.0/libgfortran/m4/cshift1.m4 *** gcc-4.3.3/libgfortran/m4/cshift1.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/cshift1.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the CSHIFT intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Feng Wang This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the CSHIFT intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Feng Wang This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Ligbfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** cshift1 (gfc_array_char * const restrict *** 68,73 **** --- 63,69 ---- index_type n; int which; 'atype_name` sh; + index_type arraysize; if (pwhich) which = *pwhich - 1; *************** cshift1 (gfc_array_char * const restrict *** 77,87 **** if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument ''`DIM''` is out of range in call to ''`CSHIFT''`"); if (ret->data == NULL) { int i; ! ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) --- 73,85 ---- if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument ''`DIM''` is out of range in call to ''`CSHIFT''`"); + arraysize = size0 ((array_t *)array); + if (ret->data == NULL) { int i; ! ret->data = internal_malloc_size (size * arraysize); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) *************** cshift1 (gfc_array_char * const restrict *** 96,101 **** --- 94,102 ---- } } + if (arraysize == 0) + return; + extent[0] = 1; count[0] = 0; n = 0; *************** cshift1_'atype_kind` (gfc_array_char * c *** 213,218 **** --- 214,220 ---- cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array)); } + void cshift1_'atype_kind`_char (gfc_array_char * const restrict ret, GFC_INTEGER_4, const gfc_array_char * const restrict array, *************** cshift1_'atype_kind`_char (gfc_array_cha *** 232,235 **** --- 234,257 ---- cshift1 (ret, array, h, pwhich, array_length); } + + void cshift1_'atype_kind`_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4, + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const 'atype_name` * const restrict pwhich, + GFC_INTEGER_4); + export_proto(cshift1_'atype_kind`_char4); + + void + cshift1_'atype_kind`_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const 'atype_name` * const restrict pwhich, + GFC_INTEGER_4 array_length) + { + cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t)); + } + #endif' diff -Nrcpad gcc-4.3.3/libgfortran/m4/eoshift1.m4 gcc-4.4.0/libgfortran/m4/eoshift1.m4 *** gcc-4.3.3/libgfortran/m4/eoshift1.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/eoshift1.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** eoshift1 (gfc_array_char * const restric *** 43,56 **** const 'atype` * const restrict h, const char * const restrict pbound, const 'atype_name` * const restrict pwhich, ! index_type size, char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; char *rptr; ! char *dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; --- 38,51 ---- const 'atype` * const restrict h, const char * const restrict pbound, const 'atype_name` * const restrict pwhich, ! index_type size, const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; char *rptr; ! char * restrict dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; *************** eoshift1 (gfc_array_char * const restric *** 103,108 **** --- 98,108 ---- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; } } + else + { + if (size0 ((array_t *) ret) == 0) + return; + } n = 0; for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) *************** eoshift1 (gfc_array_char * const restric *** 184,190 **** else while (n--) { ! memset (dest, filler, size); dest += roffset; } --- 184,197 ---- else while (n--) { ! index_type i; ! ! if (filler_len == 1) ! memset (dest, filler[0], size); ! else ! for (i = 0; i < size; i += filler_len) ! memcpy (&dest[i], filler, filler_len); ! dest += roffset; } *************** eoshift1_'atype_kind` (gfc_array_char * *** 235,243 **** const char * const restrict pbound, const 'atype_name` * const restrict pwhich) { ! eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); } void eoshift1_'atype_kind`_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, --- 242,252 ---- const char * const restrict pbound, const 'atype_name` * const restrict pwhich) { ! eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), ! "\0", 1); } + void eoshift1_'atype_kind`_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, *************** eoshift1_'atype_kind`_char (gfc_array_ch *** 257,263 **** GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { ! eoshift1 (ret, array, h, pbound, pwhich, array_length, ''` ''`); } #endif' --- 266,297 ---- GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { ! eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1); ! } ! ! ! void eoshift1_'atype_kind`_char4 (gfc_array_char * const restrict, ! GFC_INTEGER_4, ! const gfc_array_char * const restrict, ! const 'atype` * const restrict, ! const char * const restrict, ! const 'atype_name` * const restrict, ! GFC_INTEGER_4, GFC_INTEGER_4); ! export_proto(eoshift1_'atype_kind`_char4); ! ! void ! eoshift1_'atype_kind`_char4 (gfc_array_char * const restrict ret, ! GFC_INTEGER_4 ret_length __attribute__((unused)), ! const gfc_array_char * const restrict array, ! const 'atype` * const restrict h, ! const char * const restrict pbound, ! const 'atype_name` * const restrict pwhich, ! GFC_INTEGER_4 array_length, ! GFC_INTEGER_4 bound_length __attribute__((unused))) ! { ! static const gfc_char4_t space = (unsigned char) ''` ''`; ! eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t), ! (const char *) &space, sizeof (gfc_char4_t)); } #endif' diff -Nrcpad gcc-4.3.3/libgfortran/m4/eoshift3.m4 gcc-4.4.0/libgfortran/m4/eoshift3.m4 *** gcc-4.3.3/libgfortran/m4/eoshift3.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/eoshift3.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** eoshift3 (gfc_array_char * const restric *** 43,56 **** const 'atype` * const restrict h, const gfc_array_char * const restrict bound, const 'atype_name` * const restrict pwhich, ! index_type size, char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; char *rptr; ! char *dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; --- 38,51 ---- const 'atype` * const restrict h, const gfc_array_char * const restrict bound, const 'atype_name` * const restrict pwhich, ! index_type size, const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; index_type roffset; char *rptr; ! char * restrict dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS]; index_type sstride0; *************** eoshift3 (gfc_array_char * const restric *** 104,109 **** --- 99,109 ---- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; } } + else + { + if (size0 ((array_t *) ret) == 0) + return; + } extent[0] = 1; *************** eoshift3 (gfc_array_char * const restric *** 199,205 **** else while (n--) { ! memset (dest, filler, size); dest += roffset; } --- 199,212 ---- else while (n--) { ! index_type i; ! ! if (filler_len == 1) ! memset (dest, filler[0], size); ! else ! for (i = 0; i < size; i += filler_len) ! memcpy (&dest[i], filler, filler_len); ! dest += roffset; } *************** eoshift3_'atype_kind` (gfc_array_char * *** 254,262 **** const gfc_array_char * const restrict bound, const 'atype_name` * const restrict pwhich) { ! eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); } extern void eoshift3_'atype_kind`_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, --- 261,271 ---- const gfc_array_char * const restrict bound, const 'atype_name` * const restrict pwhich) { ! eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), ! "\0", 1); } + extern void eoshift3_'atype_kind`_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, *************** eoshift3_'atype_kind`_char (gfc_array_ch *** 276,282 **** GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { ! eoshift3 (ret, array, h, bound, pwhich, array_length, ''` ''`); } #endif' --- 285,316 ---- GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { ! eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1); ! } ! ! ! extern void eoshift3_'atype_kind`_char4 (gfc_array_char * const restrict, ! GFC_INTEGER_4, ! const gfc_array_char * const restrict, ! const 'atype` * const restrict, ! const gfc_array_char * const restrict, ! const 'atype_name` * const restrict, ! GFC_INTEGER_4, GFC_INTEGER_4); ! export_proto(eoshift3_'atype_kind`_char4); ! ! void ! eoshift3_'atype_kind`_char4 (gfc_array_char * const restrict ret, ! GFC_INTEGER_4 ret_length __attribute__((unused)), ! const gfc_array_char * const restrict array, ! const 'atype` * const restrict h, ! const gfc_array_char * const restrict bound, ! const 'atype_name` * const restrict pwhich, ! GFC_INTEGER_4 array_length, ! GFC_INTEGER_4 bound_length __attribute__((unused))) ! { ! static const gfc_char4_t space = (unsigned char) ''` ''`; ! eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t), ! (const char *) &space, sizeof (gfc_char4_t)); } #endif' diff -Nrcpad gcc-4.3.3/libgfortran/m4/exponent.m4 gcc-4.4.0/libgfortran/m4/exponent.m4 *** gcc-4.3.3/libgfortran/m4/exponent.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/exponent.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the EXPONENT intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the EXPONENT intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h"' --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h"' diff -Nrcpad gcc-4.3.3/libgfortran/m4/fraction.m4 gcc-4.4.0/libgfortran/m4/fraction.m4 *** gcc-4.3.3/libgfortran/m4/fraction.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/fraction.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the FRACTION intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the FRACTION intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h"' --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h"' diff -Nrcpad gcc-4.3.3/libgfortran/m4/head.m4 gcc-4.4.0/libgfortran/m4/head.m4 *** gcc-4.3.3/libgfortran/m4/head.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/head.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,4 **** ! `! Copyright 2002, 2007 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! `! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. ! Contributed by Paul Brook ! !This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** *** 6,30 **** !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 2 of the License, or (at your option) any later version. - !In addition to the permissions in the GNU General Public License, the - !Free Software Foundation gives you unlimited permission to link the - !compiled version of this file into combinations with other programs, - !and to distribute those combinations without any restriction coming - !from the use of this file. (The General Public License restrictions - !do apply in other respects; for example, they cover modification of - !the file, and distribution when not linked into a combine - !executable.) - ! !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !You should have received a copy of the GNU General Public ! !License along with libgfortran; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! !This file is machine generated.' --- 6,25 ---- !GNU libgfortran is free software; you can redistribute it and/or !modify it under the terms of the GNU General Public !License as published by the Free Software Foundation; either ! !version 3 of the License, or (at your option) any later version. !GNU libgfortran is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU General Public License for more details. ! ! !Under Section 7 of GPL version 3, you are granted additional ! !permissions described in the GCC Runtime Library Exception, version ! !3.1, as published by the Free Software Foundation. ! ! ! !You should have received a copy of the GNU General Public License and ! !a copy of the GCC Runtime Library Exception along with this program; ! !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! !. ! !This file is machine generated.' diff -Nrcpad gcc-4.3.3/libgfortran/m4/iforeach.m4 gcc-4.4.0/libgfortran/m4/iforeach.m4 *** gcc-4.3.3/libgfortran/m4/iforeach.m4 Sun Jan 13 22:13:52 2008 --- gcc-4.4.0/libgfortran/m4/iforeach.m4 Sat Sep 6 14:53:26 2008 *************** name`'rtype_qual`_'atype_code (rtype * c *** 17,23 **** index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const atype_name *base; ! rtype_name *dest; index_type rank; index_type n; --- 17,23 ---- index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const atype_name *base; ! rtype_name * restrict dest; index_type rank; index_type n; *************** name`'rtype_qual`_'atype_code (rtype * c *** 36,42 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 36,42 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; *************** void *** 152,158 **** } else { ! if (compile_options.bounds_check) { int ret_rank, mask_rank; index_type ret_extent; --- 152,158 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank, mask_rank; index_type ret_extent; *************** void *** 311,317 **** } else { ! if (compile_options.bounds_check) { int ret_rank; index_type ret_extent; --- 311,317 ---- } else { ! if (unlikely (compile_options.bounds_check)) { int ret_rank; index_type ret_extent; diff -Nrcpad gcc-4.3.3/libgfortran/m4/ifunction.m4 gcc-4.4.0/libgfortran/m4/ifunction.m4 *** gcc-4.3.3/libgfortran/m4/ifunction.m4 Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/m4/ifunction.m4 Sat Sep 6 14:53:26 2008 *************** name`'rtype_qual`_'atype_code (rtype * c *** 106,112 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 106,112 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** void *** 294,300 **** if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in u_name intrinsic"); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 294,300 ---- if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in u_name intrinsic"); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** void *** 478,484 **** (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 478,484 ---- (long int) (GFC_DESCRIPTOR_RANK (retarray)), (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { diff -Nrcpad gcc-4.3.3/libgfortran/m4/ifunction_logical.m4 gcc-4.4.0/libgfortran/m4/ifunction_logical.m4 *** gcc-4.3.3/libgfortran/m4/ifunction_logical.m4 Tue May 6 20:46:41 2008 --- gcc-4.4.0/libgfortran/m4/ifunction_logical.m4 Sat Sep 6 14:53:26 2008 *************** name`'rtype_qual`_'atype_code (rtype * c *** 106,115 **** { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " u_name intrinsic: is %d, should be %d", ! GFC_DESCRIPTOR_RANK (retarray), rank); ! if (compile_options.bounds_check) { for (n=0; n < rank; n++) { --- 106,116 ---- { if (rank != GFC_DESCRIPTOR_RANK (retarray)) runtime_error ("rank of return array incorrect in" ! " u_name intrinsic: is %ld, should be %ld", ! (long int) GFC_DESCRIPTOR_RANK (retarray), ! (long int) rank); ! if (unlikely (compile_options.bounds_check)) { for (n=0; n < rank; n++) { *************** name`'rtype_qual`_'atype_code (rtype * c *** 120,126 **** if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " u_name intrinsic in dimension %d:" ! " is %ld, should be %ld", n + 1, (long int) ret_extent, (long int) extent[n]); } } --- 121,127 ---- if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " u_name intrinsic in dimension %d:" ! " is %ld, should be %ld", (int) n + 1, (long int) ret_extent, (long int) extent[n]); } } diff -Nrcpad gcc-4.3.3/libgfortran/m4/in_pack.m4 gcc-4.4.0/libgfortran/m4/in_pack.m4 *** gcc-4.3.3/libgfortran/m4/in_pack.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/in_pack.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_pack_'rtype_ccode` ('rtype` * s *** 51,57 **** index_type dim; index_type ssize; const 'rtype_name` *src; ! 'rtype_name` *dest; 'rtype_name` *destptr; int n; int packed; --- 46,52 ---- index_type dim; index_type ssize; const 'rtype_name` *src; ! 'rtype_name` * restrict dest; 'rtype_name` *destptr; int n; int packed; diff -Nrcpad gcc-4.3.3/libgfortran/m4/in_unpack.m4 gcc-4.4.0/libgfortran/m4/in_unpack.m4 *** gcc-4.3.3/libgfortran/m4/in_unpack.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/in_unpack.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Helper function for repacking arrays. ! Copyright 2003, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_unpack_'rtype_ccode` ('rtype` * *** 48,54 **** index_type stride0; index_type dim; index_type dsize; ! 'rtype_name` *dest; int n; dest = d->data; --- 43,49 ---- index_type stride0; index_type dim; index_type dsize; ! 'rtype_name` * restrict dest; int n; dest = d->data; *************** internal_unpack_'rtype_ccode` ('rtype` * *** 63,74 **** stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! abort (); if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } if (dsize != 0) --- 58,69 ---- stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! return; if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } if (dsize != 0) diff -Nrcpad gcc-4.3.3/libgfortran/m4/matmul.m4 gcc-4.4.0/libgfortran/m4/matmul.m4 *** gcc-4.3.3/libgfortran/m4/matmul.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/matmul.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_'rtype_code` ('rtype` * const res *** 136,141 **** --- 131,177 ---- = internal_malloc_size (sizeof ('rtype_name`) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } ' sinclude(`matmul_asm_'rtype_code`.m4')dnl ` *************** sinclude(`matmul_asm_'rtype_code`.m4')dn *** 172,178 **** } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); if (GFC_DESCRIPTOR_RANK (b) == 1) { --- 208,217 ---- } if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) ! { ! if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) ! runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); ! } if (GFC_DESCRIPTOR_RANK (b) == 1) { diff -Nrcpad gcc-4.3.3/libgfortran/m4/matmull.m4 gcc-4.4.0/libgfortran/m4/matmull.m4 *** gcc-4.3.3/libgfortran/m4/matmull.m4 Tue Dec 25 10:12:41 2007 --- gcc-4.4.0/libgfortran/m4/matmull.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** matmul_'rtype_code` ('rtype` * const res *** 100,105 **** --- 95,141 ---- = internal_malloc_size (sizeof ('rtype_name`) * size0 ((array_t *) retarray)); retarray->offset = 0; } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; + ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } abase = a->data; a_kind = GFC_DESCRIPTOR_SIZE (a); diff -Nrcpad gcc-4.3.3/libgfortran/m4/maxloc0.m4 gcc-4.4.0/libgfortran/m4/maxloc0.m4 *** gcc-4.3.3/libgfortran/m4/maxloc0.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/maxloc0.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/m4/maxloc1.m4 gcc-4.4.0/libgfortran/m4/maxloc1.m4 *** gcc-4.3.3/libgfortran/m4/maxloc1.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/maxloc1.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the MAXLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/m4/maxval.m4 gcc-4.4.0/libgfortran/m4/maxval.m4 *** gcc-4.3.3/libgfortran/m4/maxval.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/maxval.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the MAXVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/m4/minloc0.m4 gcc-4.4.0/libgfortran/m4/minloc0.m4 *** gcc-4.3.3/libgfortran/m4/minloc0.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/minloc0.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/m4/minloc1.m4 gcc-4.4.0/libgfortran/m4/minloc1.m4 *** gcc-4.3.3/libgfortran/m4/minloc1.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/minloc1.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the MINLOC intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/m4/minval.m4 gcc-4.4.0/libgfortran/m4/minval.m4 *** gcc-4.3.3/libgfortran/m4/minval.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/minval.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the MINVAL intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/m4/nearest.m4 gcc-4.4.0/libgfortran/m4/nearest.m4 *** gcc-4.3.3/libgfortran/m4/nearest.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/nearest.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the NEAREST intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the NEAREST intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h"' --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h"' diff -Nrcpad gcc-4.3.3/libgfortran/m4/pack.m4 gcc-4.4.0/libgfortran/m4/pack.m4 *** gcc-4.3.3/libgfortran/m4/pack.m4 Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/m4/pack.m4 Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,316 ---- + `/* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include ' + + include(iparm.m4)dnl + + `#if defined (HAVE_'rtype_name`) + + /* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + + There are two variants of the PACK intrinsic: one, where MASK is + array valued, and the other one where MASK is scalar. */ + + void + pack_'rtype_code` ('rtype` *ret, const 'rtype` *array, + const gfc_array_l1 *mask, const 'rtype` *vector) + { + /* r.* indicates the return array. */ + index_type rstride0; + 'rtype_name` * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const 'rtype_name` *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || compile_options.bounds_check) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + + /* TODO: We could speed up pack easily in the case of only + few .TRUE. entries in MASK, by keeping track of where we + would be in the source array during the initial traversal + of MASK, and caching the pointers to those elements. Then, + supposed the number of elements is small enough, we would + only have to traverse the list, and copy those elements + into the result array. In the case of datatypes which fit + in one of the integer types we could also cache the + value instead of a pointer to it. + This approach might be bad from the point of view of + cache behavior in the case where our cache is not big + enough to hold all elements that have to be copied. */ + + const GFC_LOGICAL_1 *m = mptr; + + total = 0; + if (zero_sized) + m = NULL; + + while (m) + { + /* Test this element. */ + if (*m) + total++; + + /* Advance to the next element. */ + m += mstride[0]; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it + and increment the next dimension. */ + count[n] = 0; + /* We could precalculate this product, but this is a + less frequently used path so probably not worth + it. */ + m -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + m = NULL; + break; + } + else + { + count[n]++; + m += mstride[n]; + } + } + } + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + ret->dim[0].lbound = 0; + ret->dim[0].ubound = total - 1; + ret->dim[0].stride = 1; + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof ('rtype_name`) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = ret->dim[0].stride; + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = vector->dim[0].stride; + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } + } + + #endif + ' diff -Nrcpad gcc-4.3.3/libgfortran/m4/pow.m4 gcc-4.4.0/libgfortran/m4/pow.m4 *** gcc-4.3.3/libgfortran/m4/pow.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/pow.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Support routines for the intrinsic power (**) operator. ! Copyright 2004, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h"' --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h"' diff -Nrcpad gcc-4.3.3/libgfortran/m4/product.m4 gcc-4.4.0/libgfortran/m4/product.m4 *** gcc-4.3.3/libgfortran/m4/product.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/product.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the PRODUCT intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/m4/reshape.m4 gcc-4.4.0/libgfortran/m4/reshape.m4 *** gcc-4.3.3/libgfortran/m4/reshape.m4 Sun Nov 23 15:08:32 2008 --- gcc-4.4.0/libgfortran/m4/reshape.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the RESHAPE ! Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** reshape_'rtype_ccode` ('rtype` * const r *** 85,100 **** const 'rtype_name` *src; int n; int dim; ! int sempty, pempty; if (ret->data == NULL) { - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape->data[n * shape->dim[0].stride]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; --- 80,111 ---- const 'rtype_name` *src; int n; int dim; ! int sempty, pempty, shape_empty; ! index_type shape_data[GFC_MAX_DIMENSIONS]; ! ! rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; ! if (rdim != GFC_DESCRIPTOR_RANK(ret)) ! runtime_error("rank of return array incorrect in RESHAPE intrinsic"); ! ! shape_empty = 0; ! ! for (n = 0; n < rdim; n++) ! { ! shape_data[n] = shape->data[n * shape->dim[0].stride]; ! if (shape_data[n] <= 0) ! { ! shape_data[n] = 0; ! shape_empty = 1; ! } ! } if (ret->data == NULL) { rs = 1; for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; ! rex = shape_data[n]; ret->dim[n].ubound = rex - 1; ret->dim[n].stride = rs; rs *= rex; *************** reshape_'rtype_ccode` ('rtype` * const r *** 103,111 **** ret->data = internal_malloc_size ( rs * sizeof ('rtype_name`)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } else { ! rdim = GFC_DESCRIPTOR_RANK (ret); } rsize = 1; --- 114,207 ---- ret->data = internal_malloc_size ( rs * sizeof ('rtype_name`)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } else { ! pdim = 0; ! psize = 1; ! pempty = 1; ! pptr = NULL; ! } ! ! if (unlikely (compile_options.bounds_check)) ! { ! index_type ret_extent, source_extent; ! ! rs = 1; ! for (n = 0; n < rdim; n++) ! { ! rs *= shape_data[n]; ! ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; ! if (ret_extent != shape_data[n]) ! runtime_error("Incorrect extent in return value of RESHAPE" ! " intrinsic in dimension %ld: is %ld," ! " should be %ld", (long int) n+1, ! (long int) ret_extent, (long int) shape_data[n]); ! } ! ! source_extent = 1; ! sdim = GFC_DESCRIPTOR_RANK (source); ! for (n = 0; n < sdim; n++) ! { ! index_type se; ! se = source->dim[n].ubound + 1 - source->dim[0].lbound; ! source_extent *= se > 0 ? se : 0; ! } ! ! if (rs > source_extent && (!pad || pempty)) ! runtime_error("Incorrect size in SOURCE argument to RESHAPE" ! " intrinsic: is %ld, should be %ld", ! (long int) source_extent, (long int) rs); ! ! if (order) ! { ! int seen[GFC_MAX_DIMENSIONS]; ! index_type v; ! ! for (n = 0; n < rdim; n++) ! seen[n] = 0; ! ! for (n = 0; n < rdim; n++) ! { ! v = order->data[n * order->dim[0].stride] - 1; ! ! if (v < 0 || v >= rdim) ! runtime_error("Value %ld out of range in ORDER argument" ! " to RESHAPE intrinsic", (long int) v + 1); ! ! if (seen[v] != 0) ! runtime_error("Duplicate value %ld in ORDER argument to" ! " RESHAPE intrinsic", (long int) v + 1); ! ! seen[v] = 1; ! } ! } } rsize = 1; *************** reshape_'rtype_ccode` ('rtype` * const r *** 119,126 **** rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; ! if (rextent[n] != shape->data[dim * shape->dim[0].stride]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) --- 215,224 ---- rcount[n] = 0; rstride[n] = ret->dim[dim].stride; rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + if (rextent[n] < 0) + rextent[n] = 0; ! if (rextent[n] != shape_data[dim]) runtime_error ("shape and target do not conform"); if (rsize == rstride[n]) *************** reshape_'rtype_ccode` ('rtype` * const r *** 151,187 **** ssize = 0; } - if (pad) - { - pdim = GFC_DESCRIPTOR_RANK (pad); - psize = 1; - pempty = 0; - for (n = 0; n < pdim; n++) - { - pcount[n] = 0; - pstride[n] = pad->dim[n].stride; - pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; - if (pextent[n] <= 0) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof ('rtype_name`); --- 249,254 ---- diff -Nrcpad gcc-4.3.3/libgfortran/m4/rrspacing.m4 gcc-4.4.0/libgfortran/m4/rrspacing.m4 *** gcc-4.3.3/libgfortran/m4/rrspacing.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/rrspacing.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the RRSPACING intrinsic ! Copyright 2006, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the RRSPACING intrinsic ! Copyright 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h"' --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h"' diff -Nrcpad gcc-4.3.3/libgfortran/m4/set_exponent.m4 gcc-4.4.0/libgfortran/m4/set_exponent.m4 *** gcc-4.3.3/libgfortran/m4/set_exponent.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/set_exponent.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the SET_EXPONENT intrinsic ! Copyright 2003, 2007 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the SET_EXPONENT intrinsic ! Copyright 2003, 2007, 2009 Free Software Foundation, Inc. Contributed by Richard Henderson . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h"' --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h"' diff -Nrcpad gcc-4.3.3/libgfortran/m4/shape.m4 gcc-4.4.0/libgfortran/m4/shape.m4 *** gcc-4.3.3/libgfortran/m4/shape.m4 Sat Feb 2 13:50:55 2008 --- gcc-4.4.0/libgfortran/m4/shape.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the SHAPE intrinsic ! Copyright 2002, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the SHAPE intrinsic ! Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/m4/spacing.m4 gcc-4.4.0/libgfortran/m4/spacing.m4 *** gcc-4.3.3/libgfortran/m4/spacing.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/spacing.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the SPACING intrinsic ! Copyright 2006, 2007 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the SPACING intrinsic ! Copyright 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Steven G. Kargl This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h"' --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h"' diff -Nrcpad gcc-4.3.3/libgfortran/m4/spread.m4 gcc-4.4.0/libgfortran/m4/spread.m4 *** gcc-4.3.3/libgfortran/m4/spread.m4 Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/m4/spread.m4 Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,274 ---- + `/* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include ' + + include(iparm.m4)dnl + + `#if defined (HAVE_'rtype_name`) + + void + spread_'rtype_code` ('rtype` *ret, const 'rtype` *source, + const index_type along, const index_type pncopies) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + 'rtype_name` *rptr; + 'rtype_name` * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const 'rtype_name` *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + if (n == along - 1) + { + ret->dim[n].ubound = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = rs; + + ret->dim[n].ubound = extent[dim]-1; + rs *= extent[dim]; + dim++; + } + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof('rtype_name`)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = ret->dim[n].stride; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride; + rstride[dim] = ret->dim[n].stride; + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } + } + + /* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + + void + spread_scalar_'rtype_code` ('rtype` *ret, const 'rtype_name` *source, + const index_type along, const index_type pncopies) + { + int n; + int ncopies = pncopies; + 'rtype_name` * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof ('rtype_name`)); + ret->offset = 0; + ret->dim[0].stride = 1; + ret->dim[0].lbound = 0; + ret->dim[0].ubound = ncopies - 1; + } + else + { + if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) + / ret->dim[0].stride) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = ret->dim[0].stride; + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } + } + + #endif + ' diff -Nrcpad gcc-4.3.3/libgfortran/m4/sum.m4 gcc-4.4.0/libgfortran/m4/sum.m4 *** gcc-4.3.3/libgfortran/m4/sum.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/sum.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the SUM intrinsic ! Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the SUM intrinsic ! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/m4/transpose.m4 gcc-4.4.0/libgfortran/m4/transpose.m4 *** gcc-4.3.3/libgfortran/m4/transpose.m4 Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/m4/transpose.m4 Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** `/* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the TRANSPOSE intrinsic ! Copyright 2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Tobias Schlter This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include ' --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include ' *************** transpose_'rtype_code` ('rtype` * const *** 45,51 **** { /* r.* indicates the return array. */ index_type rxstride, rystride; ! 'rtype_name` *rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const 'rtype_name` *sptr; --- 40,46 ---- { /* r.* indicates the return array. */ index_type rxstride, rystride; ! 'rtype_name` * restrict rptr; /* s.* indicates the source array. */ index_type sxstride, systride; const 'rtype_name` *sptr; *************** transpose_'rtype_code` ('rtype` * const *** 70,75 **** --- 65,92 ---- ret->data = internal_malloc_size (sizeof ('rtype_name`) * size0 ((array_t *) ret)); ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; + src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + } sxstride = source->dim[0].stride; diff -Nrcpad gcc-4.3.3/libgfortran/m4/unpack.m4 gcc-4.4.0/libgfortran/m4/unpack.m4 *** gcc-4.3.3/libgfortran/m4/unpack.m4 Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/m4/unpack.m4 Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,334 ---- + `/* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c by Paul Brook . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + #include + #include + #include ' + + include(iparm.m4)dnl + + `#if defined (HAVE_'rtype_name`) + + void + unpack0_'rtype_code` ('rtype` *ret, const 'rtype` *vector, + const gfc_array_l1 *mask, const 'rtype_name` *fptr) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + 'rtype_name` * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + 'rtype_name` *vptr; + /* Value for field, this is constant. */ + const 'rtype_name` fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof ('rtype_name`)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } + } + + void + unpack1_'rtype_code` ('rtype` *ret, const 'rtype` *vector, + const gfc_array_l1 *mask, const 'rtype` *field) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + 'rtype_name` * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + 'rtype_name` *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const 'rtype_name` *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 + #ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 + #endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + ret->dim[n].stride = rs; + ret->dim[n].lbound = 0; + ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; + extent[n] = ret->dim[n].ubound + 1; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof ('rtype_name`)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + empty = empty || extent[n] <= 0; + rstride[n] = ret->dim[n].stride; + fstride[n] = field->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = vector->dim[0].stride; + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } + } + + #endif + ' diff -Nrcpad gcc-4.3.3/libgfortran/mk-kinds-h.sh gcc-4.4.0/libgfortran/mk-kinds-h.sh *** gcc-4.3.3/libgfortran/mk-kinds-h.sh Wed Jan 16 09:13:39 2008 --- gcc-4.4.0/libgfortran/mk-kinds-h.sh Wed Sep 10 16:39:15 2008 *************** largest="" *** 13,18 **** --- 13,19 ---- smallest="" for k in $possible_integer_kinds; do echo " integer (kind=$k) :: i" > tmp$$.f90 + echo " i = 1_$k" >> tmp$$.f90 echo " end" >> tmp$$.f90 if $compile -S tmp$$.f90 > /dev/null 2>&1; then s=`expr 8 \* $k` *************** echo "" *** 46,51 **** --- 47,53 ---- for k in $possible_real_kinds; do echo " real (kind=$k) :: x" > tmp$$.f90 + echo " x = 1.0_$k" >> tmp$$.f90 echo " end" >> tmp$$.f90 if $compile -S tmp$$.f90 > /dev/null 2>&1; then case $k in diff -Nrcpad gcc-4.3.3/libgfortran/mk-sik-inc.sh gcc-4.4.0/libgfortran/mk-sik-inc.sh *** gcc-4.3.3/libgfortran/mk-sik-inc.sh Wed Jan 16 09:13:39 2008 --- gcc-4.4.0/libgfortran/mk-sik-inc.sh Wed Sep 10 17:18:08 2008 *************** c=0 *** 7,12 **** --- 7,13 ---- for k in $possible_kinds; do echo " integer (kind=$k) :: x" > tmp$$.f90 + echo " x = 1_$k" >> tmp$$.f90 echo " end" >> tmp$$.f90 if $compile -S tmp$$.f90 > /dev/null 2>&1; then kinds="$kinds $k" diff -Nrcpad gcc-4.3.3/libgfortran/mk-srk-inc.sh gcc-4.4.0/libgfortran/mk-srk-inc.sh *** gcc-4.3.3/libgfortran/mk-srk-inc.sh Wed Jan 16 09:13:39 2008 --- gcc-4.4.0/libgfortran/mk-srk-inc.sh Wed Sep 10 17:18:08 2008 *************** c=0 *** 7,12 **** --- 7,13 ---- for k in $possible_kinds; do echo " real (kind=$k) :: x" > tmp$$.f90 + echo " x = 1.0_$k" >> tmp$$.f90 echo " end" >> tmp$$.f90 if $compile -S tmp$$.f90 > /dev/null 2>&1; then kinds="$kinds $k" diff -Nrcpad gcc-4.3.3/libgfortran/runtime/backtrace.c gcc-4.4.0/libgfortran/runtime/backtrace.c *** gcc-4.3.3/libgfortran/runtime/backtrace.c Thu Oct 18 21:25:21 2007 --- gcc-4.4.0/libgfortran/runtime/backtrace.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** ! /* Copyright (C) 2006, 2007 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 1,26 ---- ! /* Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by François-Xavier Coudert This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" *************** Boston, MA 02110-1301, USA. */ *** 43,54 **** #include #endif - #ifdef HAVE_INTPTR_T - # define INTPTR_T intptr_t - #else - # define INTPTR_T int - #endif - #ifdef HAVE_EXECINFO_H #include #endif --- 38,43 ---- *************** show_backtrace (void) *** 158,164 **** /* Write the list of addresses in hexadecimal format. */ for (i = 0; i < depth; i++) ! addr[i] = xtoa ((GFC_UINTEGER_LARGEST) (INTPTR_T) trace[i], addr_buf[i], sizeof (addr_buf[i])); /* Don't output an error message if something goes wrong, we'll simply --- 147,153 ---- /* Write the list of addresses in hexadecimal format. */ for (i = 0; i < depth; i++) ! addr[i] = xtoa ((GFC_UINTEGER_LARGEST) (intptr_t) trace[i], addr_buf[i], sizeof (addr_buf[i])); /* Don't output an error message if something goes wrong, we'll simply diff -Nrcpad gcc-4.3.3/libgfortran/runtime/compile_options.c gcc-4.4.0/libgfortran/runtime/compile_options.c *** gcc-4.3.3/libgfortran/runtime/compile_options.c Sat Sep 15 14:52:46 2007 --- gcc-4.4.0/libgfortran/runtime/compile_options.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** /* Handling of compile-time options that influence the library. ! Copyright (C) 2005, 2007 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 1,26 ---- /* Handling of compile-time options that influence the library. ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" *************** set_options (int num, int options[]) *** 105,110 **** --- 100,107 ---- compile_options.sign_zero = options[5]; if (num >= 7) compile_options.bounds_check = options[6]; + if (num >= 8) + compile_options.range_check = options[7]; /* If backtrace is required, we set signal handlers on most common signals. */ *************** set_options (int num, int options[]) *** 138,151 **** void init_compile_options (void) { ! compile_options.warn_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL ! | GFC_STD_F2003 | GFC_STD_LEGACY; compile_options.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL ! | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F77 | GFC_STD_GNU | GFC_STD_LEGACY; compile_options.pedantic = 0; compile_options.dump_core = 0; compile_options.backtrace = 0; compile_options.sign_zero = 1; } /* Function called by the front-end to tell us the --- 135,149 ---- void init_compile_options (void) { ! compile_options.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY; compile_options.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL ! | GFC_STD_F2003 | GFC_STD_F2008 | GFC_STD_F95 | GFC_STD_F77 ! | GFC_STD_GNU | GFC_STD_LEGACY; compile_options.pedantic = 0; compile_options.dump_core = 0; compile_options.backtrace = 0; compile_options.sign_zero = 1; + compile_options.range_check = 1; } /* Function called by the front-end to tell us the diff -Nrcpad gcc-4.3.3/libgfortran/runtime/convert_char.c gcc-4.4.0/libgfortran/runtime/convert_char.c *** gcc-4.3.3/libgfortran/runtime/convert_char.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/runtime/convert_char.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,69 ---- + /* Runtime conversion of strings from one character kind to another. + Copyright 2008, 2009 Free Software Foundation, Inc. + + This file is part of the GNU Fortran runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #include "libgfortran.h" + + #include + #include + + + extern void convert_char1_to_char4 (gfc_char4_t **, gfc_charlen_type, + const unsigned char *); + export_proto(convert_char1_to_char4); + + extern void convert_char4_to_char1 (unsigned char **, gfc_charlen_type, + const gfc_char4_t *); + export_proto(convert_char4_to_char1); + + + void + convert_char1_to_char4 (gfc_char4_t **dst, gfc_charlen_type len, + const unsigned char *src) + { + gfc_charlen_type i, l; + + l = len > 0 ? len : 0; + *dst = get_mem ((l + 1) * sizeof (gfc_char4_t)); + + for (i = 0; i < l; i++) + (*dst)[i] = src[i]; + + (*dst)[l] = '\0'; + } + + + void + convert_char4_to_char1 (unsigned char **dst, gfc_charlen_type len, + const gfc_char4_t *src) + { + gfc_charlen_type i, l; + + l = len > 0 ? len : 0; + *dst = get_mem ((l + 1) * sizeof (unsigned char)); + + for (i = 0; i < l; i++) + (*dst)[i] = src[i]; + + (*dst)[l] = '\0'; + } diff -Nrcpad gcc-4.3.3/libgfortran/runtime/environ.c gcc-4.4.0/libgfortran/runtime/environ.c *** gcc-4.3.3/libgfortran/runtime/environ.c Fri Oct 19 04:10:58 2007 --- gcc-4.4.0/libgfortran/runtime/environ.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** ! /* Copyright (C) 2002, 2003, 2005, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 1,26 ---- ! /* Copyright (C) 2002, 2003, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" diff -Nrcpad gcc-4.3.3/libgfortran/runtime/error.c gcc-4.4.0/libgfortran/runtime/error.c *** gcc-4.3.3/libgfortran/runtime/error.c Thu Dec 27 12:33:52 2007 --- gcc-4.4.0/libgfortran/runtime/error.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** ! /* Copyright (C) 2002, 2003, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" --- 1,27 ---- ! /* Copyright (C) 2002, 2003, 2005, 2006, 2007, 2009 ! Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" *************** show_locus (st_parameter_common *cmp) *** 199,207 **** if (filename != NULL) { st_printf ("At line %d of file %s (unit = %d, file = '%s')\n", ! (int) cmp->line, cmp->filename, cmp->unit, filename); free_mem (filename); } return; } --- 195,208 ---- if (filename != NULL) { st_printf ("At line %d of file %s (unit = %d, file = '%s')\n", ! (int) cmp->line, cmp->filename, (int) cmp->unit, filename); free_mem (filename); } + else + { + st_printf ("At line %d of file %s (unit = %d)\n", + (int) cmp->line, cmp->filename, (int) cmp->unit); + } return; } *************** runtime_error_at (const char *where, con *** 280,285 **** --- 281,301 ---- iexport(runtime_error_at); + void + runtime_warning_at (const char *where, const char *message, ...) + { + va_list ap; + + st_printf ("%s\n", where); + st_printf ("Fortran runtime warning: "); + va_start (ap, message); + st_vprintf (message, ap); + va_end (ap); + st_printf ("\n"); + } + iexport(runtime_warning_at); + + /* void internal_error()-- These are this-can't-happen errors * that indicate something deeply wrong. */ diff -Nrcpad gcc-4.3.3/libgfortran/runtime/in_pack_generic.c gcc-4.4.0/libgfortran/runtime/in_pack_generic.c *** gcc-4.3.3/libgfortran/runtime/in_pack_generic.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/runtime/in_pack_generic.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Generic helper function for repacking arrays. ! Copyright 2003, 2004, 2005, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Generic helper function for repacking arrays. ! Copyright 2003, 2004, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_pack (gfc_array_char * source) *** 51,57 **** int n; int packed; index_type size; ! int type; if (source->dim[0].stride == 0) { --- 46,52 ---- int n; int packed; index_type size; ! index_type type_size; if (source->dim[0].stride == 0) { *************** internal_pack (gfc_array_char * source) *** 59,91 **** return source->data; } ! type = GFC_DESCRIPTOR_TYPE (source); size = GFC_DESCRIPTOR_SIZE (source); ! switch (type) { ! case GFC_DTYPE_INTEGER: ! case GFC_DTYPE_LOGICAL: ! case GFC_DTYPE_REAL: ! switch (size) ! { ! case 4: ! return internal_pack_4 ((gfc_array_i4 *)source); ! ! case 8: ! return internal_pack_8 ((gfc_array_i8 *)source); ! } ! break; ! case GFC_DTYPE_COMPLEX: ! switch (size) ! { ! case 8: ! return internal_pack_c4 ((gfc_array_c4 *)source); ! ! case 16: ! return internal_pack_c8 ((gfc_array_c8 *)source); ! } ! break; default: break; --- 54,141 ---- return source->data; } ! type_size = GFC_DTYPE_TYPE_SIZE(source); size = GFC_DESCRIPTOR_SIZE (source); ! switch (type_size) { ! case GFC_DTYPE_INTEGER_1: ! case GFC_DTYPE_LOGICAL_1: ! case GFC_DTYPE_DERIVED_1: ! return internal_pack_1 ((gfc_array_i1 *) source); ! case GFC_DTYPE_INTEGER_2: ! case GFC_DTYPE_LOGICAL_2: ! return internal_pack_2 ((gfc_array_i2 *) source); ! ! case GFC_DTYPE_INTEGER_4: ! case GFC_DTYPE_LOGICAL_4: ! return internal_pack_4 ((gfc_array_i4 *) source); ! ! case GFC_DTYPE_INTEGER_8: ! case GFC_DTYPE_LOGICAL_8: ! return internal_pack_8 ((gfc_array_i8 *) source); ! ! #if defined(HAVE_GFC_INTEGER_16) ! case GFC_DTYPE_INTEGER_16: ! case GFC_DTYPE_LOGICAL_16: ! return internal_pack_16 ((gfc_array_i16 *) source); ! #endif ! case GFC_DTYPE_REAL_4: ! return internal_pack_r4 ((gfc_array_r4 *) source); ! ! case GFC_DTYPE_REAL_8: ! return internal_pack_r8 ((gfc_array_r8 *) source); ! ! #if defined (HAVE_GFC_REAL_10) ! case GFC_DTYPE_REAL_10: ! return internal_pack_r10 ((gfc_array_r10 *) source); ! #endif ! ! #if defined (HAVE_GFC_REAL_16) ! case GFC_DTYPE_REAL_16: ! return internal_pack_r16 ((gfc_array_r16 *) source); ! #endif ! case GFC_DTYPE_COMPLEX_4: ! return internal_pack_c4 ((gfc_array_c4 *) source); ! ! case GFC_DTYPE_COMPLEX_8: ! return internal_pack_c8 ((gfc_array_c8 *) source); ! ! #if defined (HAVE_GFC_COMPLEX_10) ! case GFC_DTYPE_COMPLEX_10: ! return internal_pack_c10 ((gfc_array_c10 *) source); ! #endif ! ! #if defined (HAVE_GFC_COMPLEX_16) ! case GFC_DTYPE_COMPLEX_16: ! return internal_pack_c16 ((gfc_array_c16 *) source); ! #endif ! ! case GFC_DTYPE_DERIVED_2: ! if (GFC_UNALIGNED_2(source->data)) ! break; ! else ! return internal_pack_2 ((gfc_array_i2 *) source); ! ! case GFC_DTYPE_DERIVED_4: ! if (GFC_UNALIGNED_4(source->data)) ! break; ! else ! return internal_pack_4 ((gfc_array_i4 *) source); ! ! case GFC_DTYPE_DERIVED_8: ! if (GFC_UNALIGNED_8(source->data)) ! break; ! else ! return internal_pack_8 ((gfc_array_i8 *) source); ! ! #ifdef HAVE_GFC_INTEGER_16 ! case GFC_DTYPE_DERIVED_16: ! if (GFC_UNALIGNED_16(source->data)) ! break; ! else ! return internal_pack_16 ((gfc_array_i16 *) source); ! #endif default: break; diff -Nrcpad gcc-4.3.3/libgfortran/runtime/in_unpack_generic.c gcc-4.4.0/libgfortran/runtime/in_unpack_generic.c *** gcc-4.3.3/libgfortran/runtime/in_unpack_generic.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/runtime/in_unpack_generic.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Generic helper function for repacking arrays. ! Copyright 2003, 2004, 2005, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Generic helper function for repacking arrays. ! Copyright 2003, 2004, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** internal_unpack (gfc_array_char * d, con *** 49,95 **** const char *src; int n; int size; ! int type; dest = d->data; /* This check may be redundant, but do it anyway. */ if (s == dest || !s) return; ! type = GFC_DESCRIPTOR_TYPE (d); ! size = GFC_DESCRIPTOR_SIZE (d); ! switch (type) { ! case GFC_DTYPE_INTEGER: ! case GFC_DTYPE_LOGICAL: ! case GFC_DTYPE_REAL: ! switch (size) { ! case 4: ! internal_unpack_4 ((gfc_array_i4 *)d, (const GFC_INTEGER_4 *)s); return; ! ! case 8: ! internal_unpack_8 ((gfc_array_i8 *)d, (const GFC_INTEGER_8 *)s); return; } - break; ! case GFC_DTYPE_COMPLEX: ! switch (size) { ! case 8: ! internal_unpack_c4 ((gfc_array_c4 *)d, (const GFC_COMPLEX_4 *)s); return; ! case 16: ! internal_unpack_c8 ((gfc_array_c8 *)d, (const GFC_COMPLEX_8 *)s); return; } default: break; } if (d->dim[0].stride == 0) d->dim[0].stride = 1; --- 44,167 ---- const char *src; int n; int size; ! int type_size; dest = d->data; /* This check may be redundant, but do it anyway. */ if (s == dest || !s) return; ! type_size = GFC_DTYPE_TYPE_SIZE (d); ! switch (type_size) { ! case GFC_DTYPE_INTEGER_1: ! case GFC_DTYPE_LOGICAL_1: ! case GFC_DTYPE_DERIVED_1: ! internal_unpack_1 ((gfc_array_i1 *) d, (const GFC_INTEGER_1 *) s); ! return; ! ! case GFC_DTYPE_INTEGER_2: ! case GFC_DTYPE_LOGICAL_2: ! internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s); ! return; ! ! case GFC_DTYPE_INTEGER_4: ! case GFC_DTYPE_LOGICAL_4: ! internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s); ! return; ! ! case GFC_DTYPE_INTEGER_8: ! case GFC_DTYPE_LOGICAL_8: ! internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s); ! return; ! ! #if defined (HAVE_GFC_INTEGER_16) ! case GFC_DTYPE_INTEGER_16: ! case GFC_DTYPE_LOGICAL_16: ! internal_unpack_16 ((gfc_array_i16 *) d, (const GFC_INTEGER_16 *) s); ! return; ! #endif ! case GFC_DTYPE_REAL_4: ! internal_unpack_r4 ((gfc_array_r4 *) d, (const GFC_REAL_4 *) s); ! return; ! ! case GFC_DTYPE_REAL_8: ! internal_unpack_r8 ((gfc_array_r8 *) d, (const GFC_REAL_8 *) s); ! return; ! ! #if defined(HAVE_GFC_REAL_10) ! case GFC_DTYPE_REAL_10: ! internal_unpack_r10 ((gfc_array_r10 *) d, (const GFC_REAL_10 *) s); ! return; ! #endif ! ! #if defined(HAVE_GFC_REAL_16) ! case GFC_DTYPE_REAL_16: ! internal_unpack_r16 ((gfc_array_r16 *) d, (const GFC_REAL_16 *) s); ! return; ! #endif ! case GFC_DTYPE_COMPLEX_4: ! internal_unpack_c4 ((gfc_array_c4 *)d, (const GFC_COMPLEX_4 *)s); ! return; ! ! case GFC_DTYPE_COMPLEX_8: ! internal_unpack_c8 ((gfc_array_c8 *)d, (const GFC_COMPLEX_8 *)s); ! return; ! ! #if defined(HAVE_GFC_COMPLEX_10) ! case GFC_DTYPE_COMPLEX_10: ! internal_unpack_c10 ((gfc_array_c10 *) d, (const GFC_COMPLEX_10 *) s); ! return; ! #endif ! ! #if defined(HAVE_GFC_COMPLEX_16) ! case GFC_DTYPE_COMPLEX_16: ! internal_unpack_c16 ((gfc_array_c16 *) d, (const GFC_COMPLEX_16 *) s); ! return; ! #endif ! case GFC_DTYPE_DERIVED_2: ! if (GFC_UNALIGNED_2(d->data) || GFC_UNALIGNED_2(s)) ! break; ! else { ! internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s); return; ! } ! case GFC_DTYPE_DERIVED_4: ! if (GFC_UNALIGNED_4(d->data) || GFC_UNALIGNED_4(s)) ! break; ! else ! { ! internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s); return; } ! case GFC_DTYPE_DERIVED_8: ! if (GFC_UNALIGNED_8(d->data) || GFC_UNALIGNED_8(s)) ! break; ! else { ! internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s); return; + } ! #ifdef HAVE_GFC_INTEGER_16 ! case GFC_DTYPE_DERIVED_16: ! if (GFC_UNALIGNED_16(d->data) || GFC_UNALIGNED_16(s)) ! break; ! else ! { ! internal_unpack_16 ((gfc_array_i16 *) d, (const GFC_INTEGER_16 *) s); return; } + #endif + default: break; } + size = GFC_DESCRIPTOR_SIZE (d); + if (d->dim[0].stride == 0) d->dim[0].stride = 1; *************** internal_unpack (gfc_array_char * d, con *** 101,112 **** stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! abort (); if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } src = s; --- 173,184 ---- stride[n] = d->dim[n].stride; extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; if (extent[n] <= 0) ! return; if (dsize == stride[n]) ! dsize *= extent[n]; else ! dsize = 0; } src = s; diff -Nrcpad gcc-4.3.3/libgfortran/runtime/main.c gcc-4.4.0/libgfortran/runtime/main.c *** gcc-4.3.3/libgfortran/runtime/main.c Thu Oct 18 21:25:21 2007 --- gcc-4.4.0/libgfortran/runtime/main.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** ! /* Copyright (C) 2002-2003, 2005, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught and Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 1,26 ---- ! /* Copyright (C) 2002-2003, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught and Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include *************** stupid_function_name_for_static_linking *** 45,54 **** return; } ! /* This is the offset (in bytes) required to cast from logical(8)* to ! logical(4)*. and still get the same result. Will be 0 for little-endian ! machines and 4 for big-endian machines. */ ! int l8_to_l4_offset = 0; /* Figure out endianness for this machine. */ --- 40,48 ---- return; } ! /* This will be 0 for little-endian ! machines and 1 for big-endian machines. */ ! int big_endian = 0; /* Figure out endianness for this machine. */ *************** determine_endianness (void) *** 64,72 **** u.l8 = 1; if (u.l4[0]) ! l8_to_l4_offset = 0; else if (u.l4[1]) ! l8_to_l4_offset = 1; else runtime_error ("Unable to determine machine endianness"); } --- 58,66 ---- u.l8 = 1; if (u.l4[0]) ! big_endian = 0; else if (u.l4[1]) ! big_endian = 1; else runtime_error ("Unable to determine machine endianness"); } *************** store_exe_path (const char * argv0) *** 112,118 **** char buf[PATH_MAX], *cwd, *path; ! if (argv0[0] == '/') { exe_path = argv0; please_free_exe_path_when_done = 0; --- 106,113 ---- char buf[PATH_MAX], *cwd, *path; ! /* On the simulator argv is not set. */ ! if (argv0 == NULL || argv0[0] == '/') { exe_path = argv0; please_free_exe_path_when_done = 0; diff -Nrcpad gcc-4.3.3/libgfortran/runtime/memory.c gcc-4.4.0/libgfortran/runtime/memory.c *** gcc-4.3.3/libgfortran/runtime/memory.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/runtime/memory.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Memory management routines. ! Copyright 2002, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Memory management routines. ! Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/runtime/pause.c gcc-4.4.0/libgfortran/runtime/pause.c *** gcc-4.3.3/libgfortran/runtime/pause.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/runtime/pause.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the STOP statement. ! Copyright 2002, 2005, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the STOP statement. ! Copyright 2002, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/runtime/select.c gcc-4.4.0/libgfortran/runtime/select.c *** gcc-4.3.3/libgfortran/runtime/select.c Tue Sep 11 14:53:02 2007 --- gcc-4.4.0/libgfortran/runtime/select.c Thu Apr 9 23:23:07 2009 *************** *** 1,137 **** /* Implement the SELECT statement for character variables. ! Contributed by Andy Vaught ! ! This file is part of the GNU Fortran 95 runtime library (libgfortran). ! Libgfortran is free software; you can redistribute it and/or modify ! it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) ! any later version. ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ ! ! #include "libgfortran.h" ! ! typedef struct ! { ! char *low; ! int low_len; ! char *high; ! int high_len; ! int address; ! } ! select_struct; ! ! extern int select_string (select_struct *table, int table_len, ! const char *selector, int selector_len); ! export_proto(select_string); ! ! ! /* select_string()-- Given a selector string and a table of ! * select_struct structures, return the address to jump to. */ ! ! int ! select_string (select_struct *table, int table_len, const char *selector, ! int selector_len) ! { ! select_struct *t; ! int i, low, high, mid; ! int default_jump = -1; ! ! if (table_len == 0) ! return -1; ! ! /* Record the default address if present */ ! ! if (table->low == NULL && table->high == NULL) ! { ! default_jump = table->address; ! ! table++; ! table_len--; ! if (table_len == 0) ! return default_jump; ! } ! ! /* Try the high and low bounds if present. */ ! ! if (table->low == NULL) ! { ! if (compare_string (table->high_len, table->high, ! selector_len, selector) >= 0) ! return table->address; ! ! table++; ! table_len--; ! if (table_len == 0) ! return default_jump; ! } ! ! t = table + table_len - 1; ! ! if (t->high == NULL) ! { ! if (compare_string (t->low_len, t->low, ! selector_len, selector) <= 0) ! return t->address; ! ! table_len--; ! if (table_len == 0) ! return default_jump; ! } ! /* At this point, the only table entries are bounded entries. Find ! the right entry with a binary chop. */ ! low = -1; ! high = table_len; - while (low + 1 < high) - { - mid = (low + high) / 2; ! t = table + mid; ! i = compare_string (t->low_len, t->low, selector_len, selector); ! if (i == 0) ! return t->address; ! if (i < 0) ! low = mid; ! else ! high = mid; ! } - /* The string now lies between the low indeces of the now-adjacent - high and low entries. Because it is less than the low entry of - 'high', it can't be that one. If low is still -1, then no - entries match. Otherwise, we have to check the high entry of - 'low'. */ ! if (low == -1) ! return default_jump; ! t = table + low; ! if (compare_string (selector_len, selector, ! t->high_len, t->high) <= 0) ! return t->address; - return default_jump; - } --- 1,46 ---- /* Implement the SELECT statement for character variables. ! Copyright 2008, 2009 Free Software Foundation, Inc. ! This file is part of the GNU Fortran runtime library (libgfortran). ! Libgfortran is free software; you can redistribute it and/or ! modify it under the terms of the GNU General Public ! License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ ! #include "libgfortran.h" ! /* The string selection function is defined using a few generic macros ! in select_inc.c, so we avoid code duplication between the various ! character type kinds. */ ! #undef CHARTYPE ! #define CHARTYPE char ! #undef SUFFIX ! #define SUFFIX(x) x ! #include "select_inc.c" ! #undef CHARTYPE ! #define CHARTYPE gfc_char4_t ! #undef SUFFIX ! #define SUFFIX(x) x ## _char4 ! #include "select_inc.c" diff -Nrcpad gcc-4.3.3/libgfortran/runtime/select_inc.c gcc-4.4.0/libgfortran/runtime/select_inc.c *** gcc-4.3.3/libgfortran/runtime/select_inc.c Thu Jan 1 00:00:00 1970 --- gcc-4.4.0/libgfortran/runtime/select_inc.c Thu Apr 9 23:23:07 2009 *************** *** 0 **** --- 1,133 ---- + /* Implement the SELECT statement for character variables. + Copyright 2008, 2009 Free Software Foundation, Inc. + + This file is part of the GNU Fortran runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + + #define select_string SUFFIX(select_string) + #define select_struct SUFFIX(select_struct) + #define compare_string SUFFIX(compare_string) + + typedef struct + { + CHARTYPE *low; + gfc_charlen_type low_len; + CHARTYPE *high; + gfc_charlen_type high_len; + int address; + } + select_struct; + + extern int select_string (select_struct *table, int table_len, + const CHARTYPE *selector, + gfc_charlen_type selector_len); + export_proto(select_string); + + + /* select_string()-- Given a selector string and a table of + * select_struct structures, return the address to jump to. */ + + int + select_string (select_struct *table, int table_len, const CHARTYPE *selector, + gfc_charlen_type selector_len) + { + select_struct *t; + int i, low, high, mid; + int default_jump = -1; + + if (table_len == 0) + return -1; + + /* Record the default address if present */ + + if (table->low == NULL && table->high == NULL) + { + default_jump = table->address; + + table++; + table_len--; + if (table_len == 0) + return default_jump; + } + + /* Try the high and low bounds if present. */ + + if (table->low == NULL) + { + if (compare_string (table->high_len, table->high, + selector_len, selector) >= 0) + return table->address; + + table++; + table_len--; + if (table_len == 0) + return default_jump; + } + + t = table + table_len - 1; + + if (t->high == NULL) + { + if (compare_string (t->low_len, t->low, selector_len, selector) <= 0) + return t->address; + + table_len--; + if (table_len == 0) + return default_jump; + } + + /* At this point, the only table entries are bounded entries. Find + the right entry with a binary chop. */ + + low = -1; + high = table_len; + + while (low + 1 < high) + { + mid = (low + high) / 2; + + t = table + mid; + i = compare_string (t->low_len, t->low, selector_len, selector); + + if (i == 0) + return t->address; + + if (i < 0) + low = mid; + else + high = mid; + } + + /* The string now lies between the low indeces of the now-adjacent + high and low entries. Because it is less than the low entry of + 'high', it can't be that one. If low is still -1, then no + entries match. Otherwise, we have to check the high entry of + 'low'. */ + + if (low == -1) + return default_jump; + + t = table + low; + if (compare_string (selector_len, selector, t->high_len, t->high) <= 0) + return t->address; + + return default_jump; + } diff -Nrcpad gcc-4.3.3/libgfortran/runtime/stop.c gcc-4.4.0/libgfortran/runtime/stop.c *** gcc-4.3.3/libgfortran/runtime/stop.c Fri Aug 31 14:01:34 2007 --- gcc-4.4.0/libgfortran/runtime/stop.c Thu Apr 9 23:23:07 2009 *************** *** 1,5 **** /* Implementation of the STOP statement. ! Copyright 2002, 2005, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the STOP statement. ! Copyright 2002, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** This file is part of the GNU Fortran 95 *** 7,32 **** Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 2 of the License, or (at your option) any later version. ! ! In addition to the permissions in the GNU General Public License, the ! Free Software Foundation gives you unlimited permission to link the ! compiled version of this file into combinations with other programs, ! and to distribute those combinations without any restriction coming ! from the use of this file. (The General Public License restrictions ! do apply in other respects; for example, they cover modification of ! the file, and distribution when not linked into a combine ! executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public ! License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 7,27 ---- Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include diff -Nrcpad gcc-4.3.3/libgfortran/runtime/string.c gcc-4.4.0/libgfortran/runtime/string.c *** gcc-4.3.3/libgfortran/runtime/string.c Mon Sep 3 16:44:15 2007 --- gcc-4.4.0/libgfortran/runtime/string.c Thu Apr 9 23:23:07 2009 *************** *** 1,31 **** ! /* Copyright (C) 2002, 2003, 2005, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) any later version. - In addition to the permissions in the GNU General Public License, the - Free Software Foundation gives you unlimited permission to link the - compiled version of this file into combinations with other programs, - and to distribute those combinations without any restriction coming - from the use of this file. (The General Public License restrictions - do apply in other respects; for example, they cover modification of - the file, and distribution when not linked into a combine - executable.) - Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License ! along with libgfortran; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include --- 1,26 ---- ! /* Copyright (C) 2002, 2003, 2005, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 3, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. ! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . */ #include "libgfortran.h" #include