-2010-05-22 Jerry DeLisle <jvdelisle@gcc.gnu.org>
-
- PR fortran/43851
- * match.c (gfc_match_stopcode): Use gfc_match_init_expr. Go to cleanup
- before returning MATCH_ERROR. Add check for scalar. Add check for
- default integer kind.
-
-2010-05-22 Janus Weil <janus@gcc.gnu.org>
-
- PR fortran/44212
- * match.c (gfc_match_select_type): On error jump back out of the local
- namespace.
- * parse.c (parse_derived): Defer creation of vtab symbols to resolution
- stage, more precisely to ...
- * resolve.c (resolve_fl_derived): ... this place.
-
-2010-05-22 Janus Weil <janus@gcc.gnu.org>
-
- PR fortran/44213
- * resolve.c (ensure_not_abstract): Allow abstract types with
- non-abstract ancestors.
-
-2010-05-21 Steven Bosscher <steven@gcc.gnu.org>
-
- * trans-const.c: Include realmpfr.h.
- * Make-lang.in: Update dependencies.
-
-2010-05-21 Steven Bosscher <steven@gcc.gnu.org>
-
- * trans-const.c, trans-types.c, trans-intrinsic.c:
- Clean up redundant includes.
-
-2010-05-20 Daniel Franke <franke.daniel@gmail.com>
-
- PR fortran/38407
- * lang.opt (Wunused-dummy-argument): New option.
- * gfortran.h (gfc_option_t): Add warn_unused_dummy_argument.
- * options.c (gfc_init_options): Disable warn_unused_dummy_argument.
- (set_Wall): Enable warn_unused_dummy_argument.
- (gfc_handle_option): Set warn_unused_dummy_argument according to
- command line.
- * trans-decl.c (generate_local_decl): Separate warnings about
- unused variables and unused dummy arguments.
- * invoke.texi: Documented new option.
-
-2010-05-20 Steven Bosscher <steven@gcc.gnu.org>
-
- * trans-expr.c: Do not include convert.h, ggc.h, real.h, and gimple.h.
- (gfc_conv_string_tmp): Do not assert type comparibilty.
- * trans-array.c: Do not include gimple.h, ggc.h, and real.h.
- (gfc_conv_expr_descriptor): Remove assert.
- * trans-common.c: Clarify why rtl.h and tm.h are included.
- * trans-openmp.c: Do not include ggc.h and real.h.
- Explain why gimple.h is included.
- * trans-const.c: Do not include ggc.h.
- * trans-stmt.c: Do not include gimple.h, ggc.h, and real.h.
- * trans.c: Do not include ggc.h and real.h.
- Explain why gimple.h is included.
- * trans-types.c: Do not include tm.h. Explain why langhooks.h
- and dwarf2out.h are included.
- * trans-io.c: Do not include gimple.h and real.h.
- * trans-decl.c: Explain why gimple.h, tm.h, and rtl.h are included.
- * trans-intrinsic.c: Do not include gimple.h. Explain why tm.h
- is included.
-
-2010-05-20 Tobias Burnus <burnus@net-b.de>
-
- * options.c (gfc_init_options,gfc_post_options): Enable
- flag_associative_math by default.
-
-2010-05-19 Jerry DeLisle <jvdelisle@gcc.gnu.org>
-
- PR fortran/43851
- * trans-stmt.c (gfc_trans_stop): Add generation of call to
- gfortran_error_stop_numeric. Fix up some whitespace. Use stop_string for
- blank STOP, handling a null expression. (gfc_trans_pause): Use
- pause_string for blank PAUSE.
- * trans.h: Add external function declaration for error_stop_numeric.
- * trans-decl.c (gfc_build_builtin_function_decls): Add the building of
- the declaration for the library call. Adjust whitespaces.
- * match.c (gfc_match_stopcode): Remove use of the actual stop code to
- signal no stop code. Match the expression following the stop and pass
- that to the translators. Remove the old use of digit matching. Add
- checks that the stop_code expression is INTEGER or CHARACTER, constant,
- and if CHARACTER, default character KIND.
-
-2010-05-19 Daniel Franke <franke.daniel@gmail.com>
-
- PR fortran/44055
- * lang.opt (Wconversion-extra): New option.
- * gfortran.h (gfc_option_t): Add warn_conversion_extra.
- * options.c (gfc_init_options): Disable -Wconversion-extra by default.
- (set_Wall): Enable -Wconversion.
- (gfc_handle_option): Set warn_conversion_extra.
- * intrinsic.c (gfc_convert_type_warn): Ignore kind conditions
- introduced for -Wconversion if -Wconversion-extra is present.
- * invoke.texi: Add -Wconversion to -Wall; document new behaviour of
- -Wconversion; document -Wconversion-extra.
-
-2010-05-19 Daniel Franke <franke.daniel@gmail.com>
-
- PR fortran/42360
- * gfortran.h (gfc_has_default_initializer): New.
- * expr.c (gfc_has_default_initializer): New.
- * resolve.c (has_default_initializer): Removed, use
- gfc_has_default_initializer() instead. Updated all callers.
- * trans-array.c (has_default_initializer): Removed, use
- gfc_has_default_initializer() instead. Updated all callers.
- * trans-decl.c (generate_local_decl): Do not check the
- first component only to check for initializers, but use
- gfc_has_default_initializer() instead.
-
-2010-05-19 Daniel Franke <franke.daniel@gmail.com>
-
- PR fortran/38404
- * primary.c (match_string_constant): Move start_locus just inside
- the string.
- * data.c (create_character_intializer): Clarified truncation warning.
-
-2010-05-19 Daniel Franke <franke.daniel@gmail.com>
-
- PR fortran/34505
- * intrinsic.h (gfc_check_float): New prototype.
- (gfc_check_sngl): New prototype.
- * check.c (gfc_check_float): New.
- (gfc_check_sngl): New.
- * intrinsic.c (add_functions): Moved DFLOAT from aliasing DBLE
- to be a specific for REAL. Added check routines for FLOAT, DFLOAT
- and SNGL.
- * intrinsic.texi: Removed individual nodes of FLOAT, DFLOAT and SNGL,
- added them to the list of specifics of REAL instead.
-
-2010-05-17 Janus Weil <janus@gcc.gnu.org>
-
- PR fortran/43990
- * trans-expr.c (gfc_conv_structure): Remove unneeded and buggy code.
- This is now handled via 'gfc_class_null_initializer'.
-
-2010-05-17 Janus Weil <janus@gcc.gnu.org>
-
- * class.c (gfc_add_component_ref,gfc_class_null_initializer,
- gfc_build_class_symbol,add_proc_component,add_proc_comps,
- add_procs_to_declared_vtab1,copy_vtab_proc_comps,
- add_procs_to_declared_vtab,add_generic_specifics,
- add_generics_to_declared_vtab,gfc_find_derived_vtab,
- find_typebound_proc_uop,gfc_find_typebound_proc,
- gfc_find_typebound_user_op,gfc_find_typebound_intrinsic_op,
- gfc_get_tbp_symtree): Moved here from other places.
- * expr.c (gfc_add_component_ref,gfc_class_null_initializer): Move to
- class.c.
- * gfortran.h (gfc_build_class_symbol,gfc_find_derived_vtab,
- gfc_find_typebound_proc,gfc_find_typebound_user_op,
- gfc_find_typebound_intrinsic_op,gfc_get_tbp_symtree,
- gfc_add_component_ref, gfc_class_null_initializer): Moved to class.c.
- * Make-lang.in: Add class.o.
- * symbol.c (gfc_build_class_symbol,add_proc_component,add_proc_comps,
- add_procs_to_declared_vtab1,copy_vtab_proc_comps,
- add_procs_to_declared_vtab,add_generic_specifics,
- add_generics_to_declared_vtab,gfc_find_derived_vtab,
- find_typebound_proc_uop,gfc_find_typebound_proc,
- gfc_find_typebound_user_op,gfc_find_typebound_intrinsic_op,
- gfc_get_tbp_symtree): Move to class.c.
-
-2010-05-17 Nathan Froyd <froydnj@codesourcery.com>
-
- * trans-types.c (gfc_init_types): Use build_function_type_list.
- (gfc_get_ppc_type): Likewise.
- * trans-decl.c (gfc_generate_constructors): Likewise.
- * f95-lang.c (build_builtin_fntypes): Likewise.
- (gfc_init_builtin_functions): Likewise.
- (DEF_FUNCTION_TYPE_0): Likewise.
- (DEF_FUNCTION_TYPE_1): Likewise.
- (DEF_FUNCTION_TYPE_2): Likewise.
- (DEF_FUNCTION_TYPE_3): Likewise.
- (DEF_FUNCTION_TYPE_4): Likewise.
- (DEF_FUNCTION_TYPE_5): Likewise.
- (DEF_FUNCTION_TYPE_6): Likewise.
- (DEF_FUNCTION_TYPE_7): Likewise. Use ARG7.
- (DEF_FUNCTION_TYPE_VAR_0): Use build_varags_function_type_list.
-
-2010-05-17 Nathan Froyd <froydnj@codesourcery.com>
-
- * trans-array.c (gfc_trans_array_constructor_value): Use
- build_constructor instead of build_constructor_from_list.
- (gfc_build_constant_array_constructor): Likewise.
- * trans-decl.c (create_main_function): Likewise.
- * trans-stmt.c (gfc_trans_character_select): Likewise.
-
-2010-05-17 Janus Weil <janus@gcc.gnu.org>
-
- PR fortran/44044
- * resolve.c (resolve_fl_var_and_proc): Move error messages here from ...
- (resolve_fl_variable_derived): ... this place.
- (resolve_symbol): Make sure function symbols (and their result
- variables) are not resolved twice.
-
-2010-05-16 Daniel Franke <franke.daniel@gmail.com>
-
- PR fortran/35779
- * array.c (match_array_list): Revert change from 2010-05-13.
-
-2010-05-16 Richard Guenther <rguenther@suse.de>
-
- * trans-decl.c (module_htab_decls_hash): Revert last change.
-
-2010-05-16 Richard Guenther <rguenther@suse.de>
-
- * trans-decl.c (module_htab_decls_hash): Use IDENTIFIER_HASH_VALUE.
-
-2010-05-16 Manuel López-Ibáñez <manu@gcc.gnu.org>
-
- * options.c (set_Wall): Remove special logic for Wuninitialized
- without -O.
-
-2010-05-15 Janus Weil <janus@gcc.gnu.org>
-
- PR fortran/44154
- PR fortran/42647
- * trans-decl.c (gfc_trans_deferred_vars): Modify ordering of
- if branches.
-
-2010-05-15 Janus Weil <janus@gcc.gnu.org>
-
- PR fortran/43207
- PR fortran/43969
- * gfortran.h (gfc_class_null_initializer): New prototype.
- * expr.c (gfc_class_null_initializer): New function to build a NULL
- initializer for CLASS pointers.
- * symbol.c (gfc_build_class_symbol): Modify internal naming of class
- containers. Remove default NULL initialization of $data component.
- * trans.c (gfc_allocate_array_with_status): Fix wording of an error
- message.
- * trans-expr.c (gfc_conv_initializer,gfc_trans_subcomponent_assign):
- Use new function 'gfc_class_null_initializer'.
- * trans-intrinsic.c (gfc_conv_allocated): Handle allocatable scalar
- class variables.
-
-2010-05-14 Steven G. Kargl <kargl@gcc.gnu.org>
-
- PR fortran/44135
- * fortran/interface.c (get_sym_storage_size): Use signed instead of
- unsigned mpz_get_?i routines.
-
-2010-05-14 Jakub Jelinek <jakub@redhat.com>
-
- * trans.c (trans_code): Set backend locus early.
- * trans-decl.c (gfc_get_fake_result_decl): Use source location
- of the function instead of current input_location.
-
-2010-05-13 Daniel Franke <franke.daniel@gmail.com>
-
- PR fortran/35779
- * intrinsic.c (gfc_init_expr): Renamed to gfc_init_expr_flag.
- Updated all usages.
- * expr.c (init_flag): Removed; use gfc_init_expr_flag everywhere.
- * array.c (match_array_list): Pass on gfc_init_expr_flag when matching
- iterators.
-
-2010-05-13 Jakub Jelinek <jakub@redhat.com>
-
- PR fortran/44036
- * openmp.c (resolve_omp_clauses): Allow procedure pointers in clause
- variable lists.
- * trans-openmp.c (gfc_omp_privatize_by_reference): Don't privatize
- by reference dummy procedures or non-dummy procedure pointers.
- (gfc_omp_predetermined_sharing): Return
- OMP_CLAUSE_DEFAULT_FIRSTPRIVATE for dummy procedures.
-
-2010-05-11 Daniel Franke <franke.daniel@gmail.com>
-
- PR fortran/43711
- * openmp.c (gfc_match_omp_taskwait): Report unexpected characters
- after OMP statement.
- (gfc_match_omp_critical): Likewise.
- (gfc_match_omp_flush): Likewise.
- (gfc_match_omp_workshare): Likewise.
- (gfc_match_omp_master): Likewise.
- (gfc_match_omp_ordered): Likewise.
- (gfc_match_omp_atomic): Likewise.
- (gfc_match_omp_barrier): Likewise.
- (gfc_match_omp_end_nowait): Likewise.
-
-2010-05-11 Daniel Franke <franke.daniel@gmail.com>
-
- PR fortran/31820
- * resolve.c (validate_case_label_expr): Removed FIXME.
- (resolve_select): Raise default warning on case labels out of range
- of the case expression.
-
-2010-05-10 Daniel Franke <franke.daniel@gmail.com>
-
- PR fortran/27866
- PR fortran/35003
- PR fortran/42809
- * intrinsic.c (gfc_convert_type_warn): Be more discriminative
- about conversion warnings.
-
-2010-05-10 Janus Weil <janus@gcc.gnu.org>
-
- PR fortran/44044
- * match.c (gfc_match_select_type): Move error message to
- resolve_select_type.
- * resolve.c (resolve_select_type): Error message moved here from
- gfc_match_select_type. Correctly set type of temporary.
-
-2010-05-10 Richard Guenther <rguenther@suse.de>
-
- * trans-decl.c (gfc_build_library_function_decl): Split out
- worker to ...
- (build_library_function_decl_1): ... this new function.
- Set a fnspec attribute if a specification was provided.
- (gfc_build_library_function_decl_with_spec): New function.
- (gfc_build_intrinsic_function_decls): Annotate internal_pack
- and internal_unpack.
-
-2010-05-07 Daniel Franke <franke.daniel@gmail.com>
-
- PR fortran/40728
- * intrinc.c (gfc_is_intrinsic): Do not prematurely mark symbol
- as external.
-
-2010-05-07 Jason Merrill <jason@redhat.com>
-
- * trans-expr.c (gfc_conv_procedure_call): Rename nullptr to null_ptr
- to avoid -Wc++-compat warning.
-
-2010-05-06 Manuel López-Ibáñez <manu@gcc.gnu.org>
-
- PR 40989
- * options.c (gfc_handle_option): Add argument kind.
- * gfortran.h (gfc_handle_option): Update declaration.
-
-2010-05-06 Tobias Burnus <burnus@net-b.de>
-
- PR fortran/43985
- * trans-types.c (gfc_sym_type): Mark Cray pointees as
- GFC_POINTER_TYPE_P.
-
-2010-05-05 Daniel Franke <franke.daniel@gmail.com>
-
- PR fortran/32331
- * resolve.c (traverse_data_list): Rephrase error message for
- non-constant bounds in data-implied-do.
-
-2010-05-05 Daniel Franke <franke.daniel@gmail.com>
-
- PR fortran/24978
- * gfortran.h: Removed repeat count from constructor, removed
- all usages.
- * data.h (gfc_assign_data_value_range): Changed return value from
- void to gfc_try.
- * data.c (gfc_assign_data_value): Add location to constructor element.
- (gfc_assign_data_value_range): Call gfc_assign_data_value()
- for each element in range. Return early if an error was generated.
- * resolve.c (check_data_variable): Stop early if range assignment
- generated an error.
-
-2010-05-05 Janus Weil <janus@gcc.gnu.org>
-
- PR fortran/43696
- * resolve.c (resolve_fl_derived): Some fixes for class variables.
- * symbol.c (gfc_build_class_symbol): Add separate class container for
- class pointers.
-
-2010-05-03 Steven G. Kargl <kargl@gcc.gnu.org>
-
- PR fortran/43592
- * fortran/parse.c (parse_interface): Do not dereference a NULL pointer.
-
-2010-05-02 Tobias Burnus <burnus@net-b.de>
-
- PR fortran/18918
- * intrinsic.c (add_functions): Fix GFC_STD and add gfc_resolve_ calls
- for lcobound, ucobound, image_index and this_image.
- * intrinsic.h (gfc_resolve_lcobound, gfc_resolve_this_image,
- gfc_resolve_image_index, gfc_resolve_ucobound): New prototypes.
- * iresolve.c (gfc_resolve_lcobound, gfc_resolve_this_image,
- gfc_resolve_image_index, gfc_resolve_ucobound, resolve_bound): New
- functions.
- (gfc_resolve_lbound, gfc_resolve_ubound): Use resolve_bound.
-
-2010-04-30 Tobias Burnus <burnus@net-b.de>
-
- PR fortran/18918
- PR fortran/43931
- * trans-types.c (gfc_get_array_descriptor_base): Fix index
- calculation for array descriptor types.
-
-2010-04-29 Janus Weil <janus@gcc.gnu.org>
-
- PR fortran/43896
- * symbol.c (add_proc_component,copy_vtab_proc_comps): Remove
- initializers for PPC members of the vtabs.
-
-2010-04-29 Janus Weil <janus@gcc.gnu.org>
-
- PR fortran/42274
- * symbol.c (add_proc_component,add_proc_comps): Correctly set the 'ppc'
- attribute for all PPC members of the vtypes.
- (copy_vtab_proc_comps): Copy the correct interface.
- * trans.h (gfc_trans_assign_vtab_procs): Modified prototype.
- * trans-expr.c (gfc_trans_assign_vtab_procs): Pass the derived type as
- a dummy argument and make sure all PPC members of the vtab are
- initialized correctly.
- (gfc_conv_derived_to_class,gfc_trans_class_assign): Additional argument
- in call to gfc_trans_assign_vtab_procs.
- * trans-stmt.c (gfc_trans_allocate): Ditto.
-
-2010-04-29 Paul Thomas <pault@gcc.gnu.org>
-
- PR fortran/43326
- * resolve.c (resolve_typebound_function): Renamed
- resolve_class_compcall.Do all the detection of class references
- here.
- (resolve_typebound_subroutine): resolve_class_typebound_call
- renamed. Otherwise same as resolve_typebound_function.
- (gfc_resolve_expr): Call resolve_typebound_function.
- (resolve_code): Call resolve_typebound_subroutine.
-
-2010-04-29 Janus Weil <janus@gcc.gnu.org>
-
- PR fortran/43492
- * resolve.c (resolve_typebound_generic_call): For CLASS methods
- pass back the specific symtree name, rather than the target
- name.
-
-2010-04-29 Paul Thomas <pault@gcc.gnu.org>
-
- PR fortran/42353
- * resolve.c (resolve_structure_cons): Make the initializer of
- the vtab component 'extends' the same type as the component.
-
-2010-04-29 Jerry DeLisle <jvdelisle@gcc.gnu.org>
-
- PR fortran/42680
- * interface.c (check_interface1): Pass symbol name rather than NULL to
- gfc_compare_interfaces.(gfc_compare_interfaces): Add assert to
- trap MULL. (gfc_compare_derived_types): Revert previous change
- incorporated incorrectly during merge from trunk, r155778.
- * resolve.c (check_generic_tbp_ambiguity): Pass symbol name rather
- than NULL to gfc_compare_interfaces.
- * symbol.c (add_generic_specifics): Likewise.
-
-2010-02-29 Janus Weil <janus@gcc.gnu.org>
-
- PR fortran/42353
- * interface.c (gfc_compare_derived_types): Add condition for vtype.
- * symbol.c (gfc_find_derived_vtab): Sey access to private.
- (gfc_find_derived_vtab): Likewise.
- * module.c (ab_attribute): Add enumerator AB_VTAB.
- (mio_symbol_attribute): Use new attribute, AB_VTAB.
- (check_for_ambiguous): Likewise.
-
-2010-04-29 Paul Thomas <pault@gcc.gnu.org>
- Janus Weil <janus@gcc.gnu.org>
-
- PR fortran/41829
- * trans-expr.c (select_class_proc): Remove function.
- (conv_function_val): Delete reference to previous.
- (gfc_conv_derived_to_class): Add second argument to the call to
- gfc_find_derived_vtab.
- (gfc_conv_structure): Exclude proc_pointer components when
- accessing $data field of class objects.
- (gfc_trans_assign_vtab_procs): New function.
- (gfc_trans_class_assign): Add second argument to the call to
- gfc_find_derived_vtab.
- * symbol.c (gfc_build_class_symbol): Add delayed_vtab arg and
- implement holding off searching for the vptr derived type.
- (add_proc_component): New function.
- (add_proc_comps): New function.
- (add_procs_to_declared_vtab1): New function.
- (copy_vtab_proc_comps): New function.
- (add_procs_to_declared_vtab): New function.
- (void add_generic_specifics): New function.
- (add_generics_to_declared_vtab): New function.
- (gfc_find_derived_vtab): Add second argument to the call to
- gfc_find_derived_vtab. Add the calls to
- add_procs_to_declared_vtab and add_generics_to_declared_vtab.
- * decl.c (build_sym, build_struct): Use new arg in calls to
- gfc_build_class_symbol.
- * gfortran.h : Add vtype bitfield to symbol_attr. Remove the
- definition of struct gfc_class_esym_list. Modify prototypes
- of gfc_build_class_symbol and gfc_find_derived_vtab.
- * trans-stmt.c (gfc_trans_allocate): Add second argument to the
- call to gfc_find_derived_vtab.
- * module.c : Add the vtype attribute.
- * trans.h : Add prototype for gfc_trans_assign_vtab_procs.
- * resolve.c (resolve_typebound_generic_call): Add second arg
- to pass along the generic name for class methods.
- (resolve_typebound_call): The same.
- (resolve_compcall): Use the second arg to carry the generic
- name from the above. Remove the reference to class_esym.
- (check_members, check_class_members, resolve_class_esym,
- hash_value_expr): Remove functions.
- (resolve_class_compcall, resolve_class_typebound_call): Modify
- to use vtable rather than member by member calls.
- (gfc_resolve_expr): Modify second arg in call to
- resolve_compcall.
- (resolve_select_type): Add second arg in call to
- gfc_find_derived_vtab.
- (resolve_code): Add second arg in call resolve_typebound_call.
- (resolve_fl_derived): Exclude vtypes from check for late
- procedure definitions. Likewise for checking of explicit
- interface and checking of pass arg.
- * iresolve.c (gfc_resolve_extends_type_of): Add second arg in
- calls to gfc_find_derived_vtab.
- * match.c (select_type_set_tmp): Use new arg in call to
- gfc_build_class_symbol.
- * trans-decl.c (gfc_get_symbol_decl): Complete vtable if
- necessary.
- * parse.c (endType): Finish incomplete classes.
-
-2010-04-28 Tobias Burnus <burnus@net-b.de>
-
- PR fortran/18918
- PR fortran/43919
- * simplify.c (simplify_cobound): Handle scalar coarrays.
-
-2010-04-27 Tobias Burnus <burnus@net-b.de>
-
- * gfc-internals.texi: Update copyright year.
- * gfortran.texi: Ditto.
- * invoke.texi: Ditto.
-
-2010-04-27 Tobias Burnus <burnus@net-b.de>
-
- PR fortran/18918
- * resolve.c (resolve_allocate_expr): Allow array coarrays.
- * trans-types.h (gfc_get_array_type_bounds): Update prototype.
- * trans-types.c (gfc_get_array_type_bounds,
- gfc_get_array_descriptor_base): Add corank argument.
- * trans-array.c (gfc_array_init_size): Handle corank.
- (gfc_trans_create_temp_array, gfc_array_allocate,
- gfc_conv_expr_descriptor): Add corank argument to call.
- * trans-stmt.c (gfc_trans_pointer_assign_need_temp): Ditto.
-
-2010-04-24 Steven G. Kargl <kargl@gcc.gnu.org>
-
- PR fortran/30073
- PR fortran/43793
- * trans-array.c (gfc_trans_array_bound_check): Use TREE_CODE instead
- of mucking with a tree directly.
-
-2010-04-24 Jerry DeLisle <jvdelisle@gcc.gnu.org>
-
- PR fortran/43832
- * io.c (gfc_match_open): Remove branch to syntax error. Add call to
- gfc_error with new error message.
-
-2010-04-24 Paul Thomas <pault@gcc.gnu.org>
-
- PR fortran/43841
- PR fortran/43843
- * trans-expr.c (gfc_conv_expr): Supply an address expression for
- GFC_SS_REFERENCE.
- (gfc_conv_expr_reference): Call gfc_conv_expr and return for
- GFC_SS_REFERENCE.
- * trans-array.c (gfc_add_loop_ss_code): Store the value rather
- than the address of a GFC_SS_REFERENCE.
- * trans.h : Change comment on GFC_SS_REFERENCE.
-
-2010-04-22 Richard Guenther <rguenther@suse.de>
-
- PR fortran/43829
- * resolve.c (gfc_resolve_index): Wrap around ...
- (gfc_resolve_index_1): ... this. Add parameter to allow
- any integer kind index type.
- (resolve_array_ref): Allow any integer kind for the start
- index of an array ref.
-
-2010-04-21 Jakub Jelinek <jakub@redhat.com>
-
- PR fortran/43836
- * f95-lang.c (gfc_define_builtin): Set TREE_NOTHROW on
- the decl.
-
-2010-04-20 Harald Anlauf <anlauf@gmx.de>
-
- * intrinsic.c (sort_actual): Remove 'is' in error message.
-
-2010-04-20 Paul Thomas <pault@gcc.gnu.org>
-
- PR fortran/43227
- * resolve.c (resolve_fl_derived): If a component character
- length has not been resolved, do so now.
- (resolve_symbol): The same as above for a symbol character
- length.
- * trans-decl.c (gfc_create_module_variable): A 'length' decl is
- not needed for a character valued, procedure pointer.
-
- PR fortran/43266
- * resolve.c (ensure_not_abstract_walker): If 'overriding' is
- not found, return FAILURE rather than ICEing.
-
-2010-04-19 Jakub Jelinek <jakub@redhat.com>
-
- PR fortran/43339
- * openmp.c (gfc_resolve_do_iterator): Only make iteration vars for
- sequential loops private in the innermost containing task region.
-
-2010-04-18 Eric Botcazou <ebotcazou@adacore.com>
-
- * f95-lang.c (gfc_init_decl_processing): Remove second argument in call
- to build_common_tree_nodes.
-
-2010-04-17 Steven G. Kargl <kargl@gcc.gnu.org>
-
- PR fortran/31538
- * fortran/trans-array.c (gfc_conv_ss_startstride): Remove the use of
- gfc_msg_bounds by using 'Array bound mismatch' directly.
- (gfc_trans_dummy_array_bias): Remove the use of gfc_msg_bounds. Reword
- error message to include the mismatch in the extent of array bound.
- * fortran/trans.c: Remove gfc_msg_bounds. It is only used in one place.
- * fortran/trans.h: Remove extern definition of gfc_msg_bounds.
-
-2010-04-17 Jerry DeLisle <jvdelisle@gcc.gnu.org>
-
- * gfortran.texi: Update information on temporary file locations.
-
-2010-04-16 Jakub Jelinek <jakub@redhat.com>
-
- * trans-decl.c (gfc_build_qualified_array): Ensure
- ubound.N and lbound.N artificial variable names don't appear
- in debug info.
-
-2010-04-15 Steven G. Kargl <kargl@gcc.gnu.org>
-
- PR fortran/30073
- * trans-array.c (gfc_trans_array_bound_check): Eliminate a redundant
- block of code. Set name to the variable associated with the descriptor.
-
-2010-04-15 Jakub Jelinek <jakub@redhat.com>
-
- * trans-decl.c (gfc_build_qualified_array): Clear DECL_IGNORED_P
- on VAR_DECL LBOUND and/or UBOUND, even for -O1.
-
-2010-04-14 Steven G. Kargl <kargl@gcc.gnu.org>
-
- * intrinsic.texi: Add the missing specific name of intrinsic
- procedure where the specific name is identical to the generic name.
- Fix inconsistent or mismatch in the argument names in intrinsic
- procedure descriptions. Add the SCALAR allocatable description to
- ALLOCATED.
-
-2010-04-14 Tobias Burnus <burnus@net-b.de>
-
- PR fortran/18918
- * array.c (gfc_find_array_ref): Handle codimensions.
- (gfc_match_array_spec,gfc_match_array_ref): Use gfc_fatal_error.
- * check.c (is_coarray, dim_corank_check, gfc_check_lcobound,
- gfc_check_image_index, gfc_check_this_image, gfc_check_ucobound):
- New functions.
- * gfortran.h (gfc_isym_id): Add GFC_ISYM_IMAGE_INDEX,
- GFC_ISYM_LCOBOUND, GFC_ISYM_THIS_IMAGE,
- GFC_ISYM_UCOBOUND.
- * intrinsic.h (add_functions): Add this_image, image_index,
- lcobound and ucobound intrinsics.
- * intrinsic.c (gfc_check_lcobound,gfc_check_ucobound,
- gfc_check_image_index, gfc_check_this_image,
- gfc_simplify_image_index, gfc_simplify_lcobound,
- gfc_simplify_this_image, gfc_simplify_ucobound):
- New function prototypes.
- * intrinsic.texi (IMAGE_INDEX, LCOBOUND, THIS_IMAGE
- IMAGE_INDEX): Document new intrinsic functions.
- * match.c (gfc_match_critical, sync_statement): Make -fcoarray=none
- error fatal.
- * simplify.c (simplify_bound_dim): Handle coarrays.
- (simplify_bound): Update simplify_bound_dim call.
- (gfc_simplify_num_images): Add -fcoarray=none check.
- (simplify_cobound, gfc_simplify_lcobound, gfc_simplify_ucobound,
- gfc_simplify_ucobound, gfc_simplify_ucobound): New functions.
-
-2010-04-14 Jerry DeLisle <jvdelisle@gcc.gnu.org>
-
- PR fortran/43747
- * constructor.c: Fix typo in comment.
- * expr.c (find_array_section): Add check for max array limit.
-
-2010-04-13 Iain Sandoe <iains@gcc.gnu.org>
-
- PR bootstrap/31400
- * gfortranspec.c (lookup_option): Check for -static and return
- OPTION_static.
- (lang_specific_driver): Break when OPTION_static is discovered.
-
-2010-04-12 Jerry DeLisle <jvdelisle@gcc.gnu.org>
-
- * array.c (extract_element): Restore function from trunk.
- (gfc_get_array_element): Restore function from trunk.
- (gfc_expand_constructor): Restore check against
- flag_max_array_constructor.
- * constructor.c (node_copy_and_append): Delete unused.
- * gfortran.h: Delete comment and extra include.
- * constructor.h: Bump copyright and clean up TODO comments.
- * resolve.c: Whitespace.
-
-2010-04-12 Daniel Franke <franke.daniel@gmail.com>
-
- * simplify.c (compute_dot_product): Replaced usage of ADVANCE macro
- with direct access access to elements. Adjusted prototype, fixed all
- callers.
- (gfc_simplify_dot_product): Removed duplicate check for zero-sized
- array.
- (gfc_simplify_matmul): Removed usage of ADVANCE macro.
- (gfc_simplify_spread): Removed workaround, directly insert elements
- at a given array position.
- (gfc_simplify_transpose): Likewise.
- (gfc_simplify_pack): Replaced usage of ADVANCE macro with corresponding
- function calls.
- (gfc_simplify_unpack): Likewise.
-
-2010-04-12 Daniel Franke <franke.daniel@gmail.com>
-
- * simplify.c (only_convert_cmplx_boz): Renamed to ...
- (convert_boz): ... this and moved to start of file.
- (gfc_simplify_abs): Whitespace fix.
- (gfc_simplify_acos): Whitespace fix.
- (gfc_simplify_acosh): Whitespace fix.
- (gfc_simplify_aint): Whitespace fix.
- (gfc_simplify_dint): Whitespace fix.
- (gfc_simplify_anint): Whitespace fix.
- (gfc_simplify_and): Replaced if-gate by more common switch-over-type.
- (gfc_simplify_dnint): Whitespace fix.
- (gfc_simplify_asin): Whitespace fix.
- (gfc_simplify_asinh): Moved creation of result-expr out of switch.
- (gfc_simplify_atan): Likewise.
- (gfc_simplify_atanh): Whitespace fix.
- (gfc_simplify_atan2): Whitespace fix.
- (gfc_simplify_bessel_j0): Removed ATTRIBUTE_UNUSED.
- (gfc_simplify_bessel_j1): Likewise.
- (gfc_simplify_bessel_jn): Likewise.
- (gfc_simplify_bessel_y0): Likewise.
- (gfc_simplify_bessel_y1): Likewise.
- (gfc_simplify_bessel_yn): Likewise.
- (gfc_simplify_ceiling): Reorderd statements.
- (simplify_cmplx): Use convert_boz(), check for constant arguments.
- Whitespace fix.
- (gfc_simplify_cmplx): Use correct default kind. Removed check for
- constant arguments.
- (gfc_simplify_complex): Replaced if-gate. Removed check for
- constant arguments.
- (gfc_simplify_conjg): Whitespace fix.
- (gfc_simplify_cos): Whitespace fix.
- (gfc_simplify_cosh): Replaced if-gate by more common switch-over-type.
- (gfc_simplify_dcmplx): Removed check for constant arguments.
- (gfc_simplify_dble): Use convert_boz() and gfc_convert_constant().
- (gfc_simplify_digits): Whitespace fix.
- (gfc_simplify_dim): Whitespace fix.
- (gfc_simplify_dprod): Reordered statements.
- (gfc_simplify_erf): Whitespace fix.
- (gfc_simplify_erfc): Whitespace fix.
- (gfc_simplify_epsilon): Whitespace fix.
- (gfc_simplify_exp): Whitespace fix.
- (gfc_simplify_exponent): Use convert_boz().
- (gfc_simplify_floor): Reorderd statements.
- (gfc_simplify_gamma): Whitespace fix.
- (gfc_simplify_huge): Whitespace fix.
- (gfc_simplify_iand): Whitespace fix.
- (gfc_simplify_ieor): Whitespace fix.
- (simplify_intconv): Use gfc_convert_constant().
- (gfc_simplify_int): Use simplify_intconv().
- (gfc_simplify_int2): Reorderd statements.
- (gfc_simplify_idint): Reorderd statements.
- (gfc_simplify_ior): Whitespace fix.
- (gfc_simplify_ishftc): Removed duplicate type check.
- (gfc_simplify_len): Use range_check() instead of manual range check.
- (gfc_simplify_lgamma): Removed ATTRIBUTE_UNUSED. Whitespace fix.
- (gfc_simplify_log): Whitespace fix.
- (gfc_simplify_log10): Whitespace fix.
- (gfc_simplify_minval): Whitespace fix.
- (gfc_simplify_maxval): Whitespace fix.
- (gfc_simplify_mod): Whitespace fix.
- (gfc_simplify_modulo): Whitespace fix.
- (simplify_nint): Reorderd statements.
- (gfc_simplify_not): Whitespace fix.
- (gfc_simplify_or): Replaced if-gate by more common switch-over-type.
- (gfc_simplify_radix): Removed unused result-variable. Whitespace fix.
- (gfc_simplify_range): Removed unused result-variable. Whitespace fix.
- (gfc_simplify_real): Use convert_boz() and gfc_convert_constant().
- (gfc_simplify_realpart): Whitespace fix.
- (gfc_simplify_selected_char_kind): Removed unused result-variable.
- (gfc_simplify_selected_int_kind): Removed unused result-variable.
- (gfc_simplify_selected_real_kind): Removed unused result-variable.
- (gfc_simplify_sign): Whitespace fix.
- (gfc_simplify_sin): Whitespace fix.
- (gfc_simplify_sinh): Replaced if-gate by more common switch-over-type.
- (gfc_simplify_sqrt): Avoided goto by inlining check. Whitespace fix.
- (gfc_simplify_tan): Replaced if-gate by more common switch-over-type.
- (gfc_simplify_tanh): Replaced if-gate by more common switch-over-type.
- (gfc_simplify_xor): Replaced if-gate by more common switch-over-type.
-
-2010-04-12 Daniel Franke <franke.daniel@gmail.com>
-
- * gfortran.h (gfc_start_constructor): Removed.
- (gfc_get_array_element): Removed.
- * array.c (gfc_start_constructor): Removed, use gfc_get_array_expr
- instead. Fixed all callers.
- (extract_element): Removed.
- (gfc_expand_constructor): Temporarily removed check for
- max-array-constructor. Will be re-introduced later if still required.
- (gfc_get_array_element): Removed, use gfc_constructor_lookup_expr
- instead. Fixed all callers.
- * expr.c (find_array_section): Replaced manual lookup of elements
- by gfc_constructor_lookup.
-
-2010-04-12 Daniel Franke <franke.daniel@gmail.com>
-
- * gfortran.h (gfc_get_null_expr): New prototype.
- (gfc_get_operator_expr): New prototype.
- (gfc_get_character_expr): New prototype.
- (gfc_get_iokind_expr): New prototype.
- * expr.c (gfc_get_null_expr): New.
- (gfc_get_character_expr): New.
- (gfc_get_iokind_expr): New.
- (gfc_get_operator_expr): Moved here from matchexp.c (build_node).
- * matchexp.c (build_node): Renamed and moved to
- expr.c (gfc_get_operator_expr). Reordered arguments to match
- other functions. Fixed all callers.
- (gfc_get_parentheses): Use specific function to build expr.
- * array.c (gfc_match_array_constructor): Likewise.
- * arith.c (eval_intrinsic): Likewise.
- (gfc_hollerith2int): Likewise.
- (gfc_hollerith2real): Likewise.
- (gfc_hollerith2complex): Likewise.
- (gfc_hollerith2logical): Likewise.
- * data.c (create_character_intializer): Likewise.
- * decl.c (gfc_match_null): Likewise.
- (enum_initializer): Likewise.
- * io.c (gfc_match_format): Likewise.
- (match_io): Likewise.
- * match.c (gfc_match_nullify): Likewise.
- * primary.c (match_string_constant): Likewise.
- (match_logical_constant): Likewise.
- (build_actual_constructor): Likewise.
- * resolve.c (build_default_init_expr): Likewise.
- * symbol.c (generate_isocbinding_symbol): Likewise.
- (gfc_build_class_symbol): Likewise.
- (gfc_find_derived_vtab): Likewise.
- * simplify.c (simplify_achar_char): Likewise.
- (gfc_simplify_adjustl): Likewise.
- (gfc_simplify_adjustr): Likewise.
- (gfc_simplify_and): Likewise.
- (gfc_simplify_bit_size): Likewise.
- (gfc_simplify_is_iostat_end): Likewise.
- (gfc_simplify_is_iostat_eor): Likewise.
- (gfc_simplify_isnan): Likewise.
- (simplify_bound): Likewise.
- (gfc_simplify_leadz): Likewise.
- (gfc_simplify_len_trim): Likewise.
- (gfc_simplify_logical): Likewise.
- (gfc_simplify_maxexponent): Likewise.
- (gfc_simplify_minexponent): Likewise.
- (gfc_simplify_new_line): Likewise.
- (gfc_simplify_null): Likewise.
- (gfc_simplify_or): Likewise.
- (gfc_simplify_precision): Likewise.
- (gfc_simplify_repeat): Likewise.
- (gfc_simplify_scan): Likewise.
- (gfc_simplify_size): Likewise.
- (gfc_simplify_trailz): Likewise.
- (gfc_simplify_trim): Likewise.
- (gfc_simplify_verify): Likewise.
- (gfc_simplify_xor): Likewise.
- * trans-io.c (build_dt): Likewise.
- (gfc_new_nml_name_expr): Removed.
-
-2010-04-12 Daniel Franke <franke.daniel@gmail.com>
-
- * arith.h (gfc_constant_result): Removed prototype.
- * constructor.h (gfc_build_array_expr): Removed prototype.
- (gfc_build_structure_constructor_expr): Removed prototype.
- * gfortran.h (gfc_int_expr): Removed prototype.
- (gfc_logical_expr): Removed prototype.
- (gfc_get_array_expr): New prototype.
- (gfc_get_structure_constructor_expr): New prototype.
- (gfc_get_constant_expr): New prototype.
- (gfc_get_int_expr): New prototype.
- (gfc_get_logical_expr): New prototype.
- * arith.c (gfc_constant_result): Moved and renamed to
- expr.c (gfc_get_constant_expr). Fixed all callers.
- * constructor.c (gfc_build_array_expr): Moved and renamed to
- expr.c (gfc_get_array_expr). Split gfc_typespec argument to type
- and kind. Fixed all callers.
- (gfc_build_structure_constructor_expr): Moved and renamed to
- expr.c (gfc_get_structure_constructor_expr). Split gfc_typespec argument
- to type and kind. Fixed all callers.
- * expr.c (gfc_logical_expr): Renamed to ...
- (gfc_get_logical_expr): ... this. Added kind argument. Fixed all callers.
- (gfc_int_expr): Renamed to ...
- (gfc_get_int_expr): ... this. Added kind and where arguments. Fixed all
- callers.
- (gfc_get_constant_expr): New.
- (gfc_get_array_expr): New.
- (gfc_get_structure_constructor_expr): New.
- * simplify.c (int_expr_with_kind): Removed, callers use gfc_get_int_expr
- instead.
-
-2010-04-12 Daniel Franke <franke.daniel@gmail.com>
-
- * constructor.h: New.
- * constructor.c: New.
- * Make-lang.in: Add new files to F95_PARSER_OBJS.
- * arith.c (reducy_unary): Use constructor API.
- (reduce_binary_ac): Likewise.
- (reduce_binary_ca): Likewise.
- (reduce_binary_aa): Likewise.
- * check.c (gfc_check_pack): Likewise.
- (gfc_check_reshape): Likewise.
- (gfc_check_unpack): Likewise.
- * decl.c (add_init_expr_to_sym): Likewise.
- (build_struct): Likewise.
- * dependency.c (gfc_check_dependency): Likewise.
- (contains_forall_index_p): Likewise.
- * dump-parse-tree.c (show_constructor): Likewise.
- * expr.c (free_expr0): Likewise.
- (gfc_copy_expr): Likewise.
- (gfc_is_constant_expr): Likewise.
- (simplify_constructor): Likewise.
- (find_array_element): Likewise.
- (find_component_ref): Likewise.
- (find_array_section): Likewise.
- (find_substring_ref): Likewise.
- (simplify_const_ref): Likewise.
- (scalarize_intrinsic_call): Likewise.
- (check_alloc_comp_init): Likewise.
- (gfc_default_initializer): Likewise.
- (gfc_traverse_expr): Likewise.
- * iresolve.c (check_charlen_present): Likewise.
- (gfc_resolve_reshape): Likewise.
- (gfc_resolve_transfer): Likewise.
- * module.c (mio_constructor): Likewise.
- * primary.c (build_actual_constructor): Likewise.
- (gfc_match_structure_constructor): Likewise.
- * resolve.c (resolve_structure_cons): Likewise.
- * simplify.c (is_constant_array_expr): Likewise.
- (init_result_expr): Likewise.
- (transformational_result): Likewise.
- (simplify_transformation_to_scalar): Likewise.
- (simplify_transformation_to_array): Likewise.
- (gfc_simplify_dot_product): Likewise.
- (simplify_bound): Likewise.
- (simplify_matmul): Likewise.
- (simplify_minval_maxval): Likewise.
- (gfc_simplify_pack): Likewise.
- (gfc_simplify_reshape): Likewise.
- (gfc_simplify_shape): Likewise.
- (gfc_simplify_spread): Likewise.
- (gfc_simplify_transpose): Likewise.
- (gfc_simplify_unpack): Likewise.q
- (gfc_convert_constant): Likewise.
- (gfc_convert_char_constant): Likewise.
- * target-memory.c (size_array): Likewise.
- (encode_array): Likewise.
- (encode_derived): Likewise.
- (interpret_array): Likewise.
- (gfc_interpret_derived): Likewise.
- (expr_to_char): Likewise.
- (gfc_merge_initializers): Likewise.
- * trans-array.c (gfc_get_array_constructor_size): Likewise.
- (gfc_trans_array_constructor_value): Likewise.
- (get_array_ctor_strlen): Likewise.
- (gfc_constant_array_constructor_p): Likewise.
- (gfc_build_constant_array_constructor): Likewise.
- (gfc_trans_array_constructor): Likewise.
- (gfc_conv_array_initializer): Likewise.
- * trans-decl.c (check_constant_initializer): Likewise.
- * trans-expr.c (flatten_array_ctors_without_strlen): Likewise.
- (gfc_apply_interface_mapping_to_cons): Likewise.
- (gfc_trans_structure_assign): Likewise.
- (gfc_conv_structure): Likewise.
- * array.c (check_duplicate_iterator): Likewise.
- (match_array_list): Likewise.
- (match_array_cons_element): Likewise.
- (gfc_match_array_constructor): Likewise.
- (check_constructor_type): Likewise.
- (check_constructor): Likewise.
- (expand): Likewise.
- (expand_constructor): Likewise.
- (extract_element): Likewise.
- (gfc_expanded_ac): Likewise.
- (resolve_array_list): Likewise.
- (gfc_resolve_character_array_constructor): Likewise.
- (copy_iterator): Renamed to ...
- (gfc_copy_iterator): ... this.
- (gfc_append_constructor): Removed.
- (gfc_insert_constructor): Removed unused function.
- (gfc_get_constructor): Removed.
- (gfc_free_constructor): Removed.
- (qgfc_copy_constructor): Removed.
- * gfortran.h (struct gfc_expr): Removed member 'con_by_offset'.
- Removed all references. Replaced constructor list by splay-tree.
- (struct gfc_constructor): Removed member 'next', moved 'offset' from
- the inner struct, added member 'base'.
- (gfc_append_constructor): Removed prototype.
- (gfc_insert_constructor): Removed prototype.
- (gfc_get_constructor): Removed prototype.
- (gfc_free_constructor): Removed prototype.
- (qgfc_copy_constructor): Removed prototype.
- (gfc_copy_iterator): New prototype.
- * trans-array.h (gfc_constant_array_constructor_p): Adjusted prototype.
-
-2010-04-10 Tobias Burnus <burnus@net-b.de>
-
- PR fortran/43591
- * expr.c (gfc_is_constant_expr, gfc_traverse_expr): Handle
- proc-pointers and type-bound procedures.
- (gfc_specification_expr): Check proc-pointers for pureness.
-
-2010-04-09 Iain Sandoe <iains@gcc.gnu.org>
-
- PR bootstrap/43684
- * gfortranspec.c (lang_specific_driver): Do not expose vars
- only used by HAVE_LD_STATIC_DYNAMIC targets unless compiling
- for such.
-
-2010-04-09 Tobias Burnus <burnus@net-b.de>
-
- PR fortran/18918
- * decl.c (variable_decl, match_attr_spec): Fix setting the array
- spec.
- * array.c (match_subscript,gfc_match_array_ref): Add coarray support.
- * data.c (gfc_assign_data_value): Ditto.
- * expr.c (gfc_check_pointer_assign): Add check for coarray constraint.
- (gfc_traverse_expr): Traverse also through codimension expressions.
- (gfc_is_coindexed, gfc_has_ultimate_allocatable,
- gfc_has_ultimate_pointer): New functions.
- * gfortran.h (gfc_array_ref_dimen_type): Add DIMEN_STAR for coarrays.
- (gfc_array_ref): Add codimen.
- (gfc_array_ref): Add in_allocate.
- (gfc_is_coindexed, gfc_has_ultimate_allocatable,
- gfc_has_ultimate_pointer): Add prototypes.
- * interface.c (compare_parameter, compare_actual_formal,
- check_intents): Add coarray constraints.
- * match.c (gfc_match_iterator): Add coarray constraint.
- * match.h (gfc_match_array_ref): Update interface.
- * primary.c (gfc_match_varspec): Handle codimensions.
- * resolve.c (coarray_alloc, inquiry_argument): New static variables.
- (check_class_members): Return gfc_try instead for error recovery.
- (resolve_typebound_function,resolve_typebound_subroutine,
- check_members): Handle return value of check_class_members.
- (resolve_structure_cons, resolve_actual_arglist, resolve_function,
- check_dimension, compare_spec_to_ref, resolve_array_ref,
- resolve_ref, resolve_variable, gfc_resolve_expr, conformable_arrays,
- resolve_allocate_expr, resolve_ordinary_assign): Add coarray
- support.
- * trans-array.c (gfc_conv_array_ref, gfc_walk_variable_expr):
- Skip over coarray refs.
- (gfc_array_allocate) Add support for references containing coindexes.
- * trans-expr.c (gfc_add_interface_mapping): Copy coarray attribute.
- (gfc_map_intrinsic_function): Ignore codimensions.
-
-2010-04-08 Bud Davis <bdavis9659@sbcglobal.net>
-
- PR fortran/28039
- * io.c (check_format_string): Added check for additional non
- blank characters after the format string was successfully
- parsed.
- * io.c (check_format): Changed the error messages for positive
- int required and period required to drop through the error logic
- and report with gfc_error instead of gfc_error_now. Corrected
- format postion for hollerith strings.
-
-2010-04-08 Tobias Burnus <burnus@net-b.de>
-
- * module.c (use_iso_fortran_env_module): Fix standard check.
-
-2010-04-07 Jakub Jelinek <jakub@redhat.com>
-
- * parse.c (parse_derived, parse_enum): Avoid set but not used
- warning.
-
-2010-04-07 Janne Blomqvist <jb@gcc.gnu.org>
-
- PR fortran/40539
- * gfortran.texi: Add section about representation of
- LOGICAL variables.
-
-2010-04-07 Simon Baldwin <simonb@google.com>
-
- * cpp.c (cb_cpp_error): Add warning reason argument, set a value
- for diagnostic_override_option_index if CPP_W_WARNING_DIRECTIVE.
-
-2010-04-07 Richard Guenther <rguenther@suse.de>
-
- * options.c (gfc_init_options): Do not set.
-
-2010-04-06 Tobias Burnus <burnus@net-b.de>
-
- PR fortran/18918
- * array.c (gfc_match_array_spec): Add error for -fcoarray=none.
- * match.c (gfc_match_critical, sync_statement): Ditto.
- * gfortran.h (gfc_fcoarray): New enum.
- (gfc_option_t): Use it.
- * lang.opt (fcoarray): Add new flag.
- * invoke.texi (fcoarray): Document it.
- * options.c (gfc_init_options,gfc_handle_option): Handle -fcoarray=.
- (gfc_handle_coarray_option): New function.
-
-2010-04-06 Tobias Burnus <burnus@net-b.de>
-
- PR fortran/18918
- * gfortran.h (gfc_array_spec): Add cotype.
- * array.c (gfc_match_array_spec,gfc_set_array_spec): Use it
- and defer error diagnostic.
- * resolve.c (resolve_fl_derived): Add missing check.
- (resolve_symbol): Add cotype/type check.
- * parse.c (parse_derived): Fix setting of coarray_comp.
-
-2010-04-06 Tobias Burnus <burnus@net-b.de>
-
- PR fortran/18918
- * array.c (gfc_free_array_spec,gfc_resolve_array_spec,
- match_array_element_spec,gfc_copy_array_spec,
- gfc_compare_array_spec): Include corank.
- (match_array_element_spec,gfc_set_array_spec): Support codimension.
- * decl.c (build_sym,build_struct,variable_decl,
- match_attr_spec,attr_decl1,cray_pointer_decl,
- gfc_match_volatile): Add codimension.
- (gfc_match_codimension): New function.
- * dump-parse-tree.c (show_array_spec,show_attr): Support codimension.
- * gfortran.h (symbol_attribute,gfc_array_spec): Ditto.
- (gfc_add_codimension): New function prototype.
- * match.h (gfc_match_codimension): New function prototype.
- (gfc_match_array_spec): Update prototype
- * match.c (gfc_match_common): Update gfc_match_array_spec call.
- * module.c (MOD_VERSION): Bump.
- (mio_symbol_attribute): Support coarray attributes.
- (mio_array_spec): Add corank support.
- * parse.c (decode_specification_statement,decode_statement,
- parse_derived): Add coarray support.
- * resolve.c (resolve_formal_arglist, was_declared,
- is_non_constant_shape_array, resolve_fl_variable,
- resolve_fl_derived, resolve_symbol): Add coarray support.
- * symbol.c (check_conflict, gfc_add_volatile, gfc_copy_attr,
- gfc_build_class_symbol): Add coarray support.
- (gfc_add_codimension): New function.
-
-2010-04-06 Tobias Burnus <burnus@net-b.de>
-
- PR fortran/18918
- * iso-fortran-env.def: Add the integer parameters atomic_int_kind,
- atomic_logical_kind, iostat_inquire_internal_unit, stat_locked,
- stat_locked_other_image, stat_stopped_image and stat_unlocked of
- Fortran 2008.
- * intrinsic.texi (iso_fortran_env): Ditto.
- * libgfortran.h (libgfortran_stat_codes): New enum.
- * module.c (use_iso_fortran_env_module): Honour -std= when loading
- constants from the intrinsic module.
-
-2010-04-06 Tobias Burnus <burnus@net-b.de>
-
- PR fortran/39997
- * intrinsic.c (add_functions): Add num_images.
- * decl.c (gfc_match_end): Handle END CRITICAL.
- * intrinsic.h (gfc_simplify_num_images): Add prototype.
- * dump-parse-tree.c (show_code_node): Dump CRITICAL, ERROR STOP,
- and SYNC.
- * gfortran.h (gfc_statement): Add enum items for those.
- (gfc_exec_op) Ditto.
- (gfc_isym_id): Add num_images.
- * trans-stmt.c (gfc_trans_stop): Handle ERROR STOP.
- (gfc_trans_sync,gfc_trans_critical): New functions.
- * trans-stmt.h (gfc_trans_stop,gfc_trans_sync,
- gfc_trans_critical): Add/update prototypes.
- * trans.c (gfc_trans_code): Handle CRITICAL, ERROR STOP,
- and SYNC statements.
- * trans.h (gfor_fndecl_error_stop_string) Add variable.
- * resolve.c (resolve_sync): Add function.
- (gfc_resolve_blocks): Handle CRITICAL.
- (resolve_code): Handle CRITICAL, ERROR STOP,
- (resolve_branch): Add CRITICAL constraint check.
- and SYNC statements.
- * st.c (gfc_free_statement): Add new statements.
- * trans-decl.c (gfor_fndecl_error_stop_string): Global variable.
- (gfc_build_builtin_function_decls): Initialize it.
- * match.c (gfc_match_if): Handle ERROR STOP and SYNC.
- (gfc_match_critical, gfc_match_error_stop, sync_statement,
- gfc_match_sync_all, gfc_match_sync_images, gfc_match_sync_memory):
- New functions.
- (match_exit_cycle): Handle CRITICAL constraint.
- (gfc_match_stopcode): Handle ERROR STOP.
- * match.h (gfc_match_critical, gfc_match_error_stop,
- gfc_match_sync_all, gfc_match_sync_images,
- gfc_match_sync_memory): Add prototype.
- * parse.c (decode_statement, gfc_ascii_statement,
- parse_executable): Handle new statements.
- (parse_critical_block): New function.
- * parse.h (gfc_compile_state): Add COMP_CRITICAL.
- * intrinsic.texi (num_images): Document new function.
- * simplify.c (gfc_simplify_num_images): Add function.
-
-2010-04-06 Tobias Burnus <burnus@net-b.de>
-
- PR fortran/43178
- * trans-array.c (gfc_conv_expr_descriptor): Update
- gfc_trans_scalar_assign call.
- (has_default_initializer): New function.
- (gfc_trans_deferred_array): Nullify less often.
- * trans-expr.c (gfc_conv_subref_array_arg,
- gfc_trans_subcomponent_assign): Update call to
- gfc_trans_scalar_assign.
- (gfc_trans_scalar_assign): Add parameter and pass it on.
- (gfc_trans_assignment_1): Optionally, do not dealloc before
- assignment.
- * trans-openmp.c (gfc_trans_omp_array_reduction): Update
- call to gfc_trans_scalar_assign.
- * trans-decl.c (gfc_get_symbol_decl): Do not always apply
- initializer to static variables.
- (gfc_init_default_dt): Add dealloc parameter and pass it on.
- * trans-stmt.c (forall_make_variable_temp,
- generate_loop_for_temp_to_lhs, generate_loop_for_rhs_to_temp,
- gfc_trans_forall_1, gfc_trans_where_assign, gfc_trans_where_3
- gfc_trans_allocate): Update gfc_trans_assignment call.
- * trans.h (gfc_trans_scalar_assign, gfc_init_default_dt,
- gfc_init_default_dt, gfc_trans_assignment): Add bool dealloc
- parameter to prototype.
-
-2010-03-31 Paul Thomas <pault@gcc.gnu.org>
-
- * ioparm.def : Update copyright.
- * lang.opt : ditto
- * trans-array.c : ditto
- * trans-array.h : ditto
- * expr.c: ditto
- * trans-types.c: ditto
- * dependency.c : ditto
- * gfortran.h : ditto
- * options.c : ditto
- * trans-io.c : ditto
- * trans-intrinsic.c : ditto
- * libgfortran.h : ditto
- * invoke.texi : ditto
- * intrinsic.texi : ditto
- * trans.c : ditto
- * trans.h : ditto
- * intrinsic.c : ditto
- * interface.c : ditto
- * iresolve.c : ditto
- * trans-stmt.c : ditto
- * trans-stmt.h : ditto
- * parse,c : ditto
- * match.h : ditto
- * error.c : ditto
-
-2010-03-20 Paul Thomas <pault@gcc.gnu.org>
-
- PR fortran/43450
- * trans-decl.c (gfc_create_module_variable): With -fwhole-file
- do not assert the context of derived types.
-
-2010-03-20 Jerry DeLisle <jvdelisle@gcc.gnu.org>
-
- PR fortran/43409
- * ioparm.def: Change inquire size variable to type pointer to
- GFC_IO_INT type.
-
-2010-03-18 Paul Thomas <pault@gcc.gnu.org>
-
- PR fortran/43039
- * trans-expr.c (conv_parent_component_references): Ensure that
- 'dt' has a backend_decl.
-
- PR fortran/43043
- * trans-expr.c (gfc_conv_structure): Ensure that the derived
- type has a backend_decl.
-
- PR fortran/43044
- * resolve.c (resolve_global_procedure): Check that the 'cl'
- structure is not NULL.
-
-2010-03-18 Shujing Zhao <pearly.zhao@oracle.com>
-
- * lang.opt (-ffixed-line-length-, ffree-line-length-): Remove
- redundant tab.
-
-2010-03-17 Tobias Burnus <burnus@net-b.de>
-
- PR fortran/43331
- * trans-array.c (gfc_conv_array_index_offset,gfc_conv_array_ref,
- gfc_conv_ss_startstride): Remove no-longer-needed cp_was_assumed
- check.
- * decl.c (gfc_match_derived_decl): Don't mark assumed-size Cray
- pointees as having explizit size.
- * expr.c (gfc_check_assign): Remove now unreachable Cray pointee
- check.
- * trans-types.c (gfc_is_nodesc_array): Add cp_was_assumed to assert.
- (gfc_sym_type): Don't mark Cray pointees as restricted pointers.
- * resolve.c (resolve_symbol): Handle cp_was_assumed.
- * trans-decl.c (gfc_trans_deferred_vars): Ditto.
- (gfc_finish_var_decl): Don't mark Cray pointees as restricted
- pointers.
-
-2010-03-14 Tobias Burnus <burnus@net-b.de>
-
- PR fortran/43362
- * resolve.c (resolve_structure_cons): Add missing PURE constraint.
- (resolve_ordinary_assign): Add check to avoid segfault.
-
2010-03-12 Paul Thomas <pault@gcc.gnu.org>
PR fortran/43291
and DECL_SIZE when encountering a larger common block and call
layout_decl.
-2010-02-24 Tobias Burnus <burnus@net-b.de>
+2010-02-24 Tobias Burnus <burnus@net-b.de>
PR fortran/43042
* trans-expr.c (gfc_conv_initializer): Call directly
- gfc_conv_constant for C_NULL_(FUN)PTR.
+ gfc_conv_constant for C_NULL_(FUN)PTR.
2010-02-22 Paul Thomas <pault@gcc.gnu.org>
2010-01-14 Paul Thomas <pault@gcc.gnu.org>
- PR fortran/41478
- * trans-array.c (duplicate_allocatable): Static version of
+ PR fortran/41478
+ * trans-array.c (duplicate_allocatable): Static version of
gfc_duplicate_allocatable with provision to handle scalar
components. New boolean argument to switch off call to malloc
if true.
use associated but not generic is given an interface that
includes itself, then make it generic.
-2010-01-11 Joseph Myers <joseph@codesourcery.com>
+2010-01-11 Joseph Myers <joseph@codesourcery.com>
Shujing Zhao <pearly.zhao@oracle.com>
PR translation/42469
#include "dependency.h"
#include "data.h"
#include "target-memory.h" /* for gfc_simplify_transfer */
-#include "constructor.h"
/* Types used in equivalence statements. */
/* We use bitmaps to determine if a branch target is valid. */
static bitmap_obstack labels_obstack;
-/* True when simplifying a EXPR_VARIABLE argument to an inquiry function. */
-static bool inquiry_argument = false;
-
int
gfc_is_formal_arg (void)
{
{
sym->as->type = AS_ASSUMED_SHAPE;
for (i = 0; i < sym->as->rank; i++)
- sym->as->lower[i] = gfc_get_int_expr (gfc_default_integer_kind,
- NULL, 1);
+ sym->as->lower[i] = gfc_int_expr (1);
}
if ((sym->as && sym->as->rank > 0 && sym->as->type == AS_ASSUMED_SHAPE)
if (gfc_elemental (proc))
{
- /* F2008, C1289. */
- if (sym->attr.codimension)
- {
- gfc_error ("Coarray dummy argument '%s' at %L to elemental "
- "procedure", sym->name, &sym->declared_at);
- continue;
- }
-
if (sym->as != NULL)
{
gfc_error ("Argument '%s' of elemental procedure at %L must "
}
+static bool
+has_default_initializer (gfc_symbol *der)
+{
+ gfc_component *c;
+
+ gcc_assert (der->attr.flavor == FL_DERIVED);
+ 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.u.derived))))
+ break;
+
+ return c != NULL;
+}
+
/* Resolve common variables. */
static void
resolve_common_vars (gfc_symbol *sym, bool named_common)
gfc_error_now ("Derived type variable '%s' in COMMON at %L "
"has an ultimate component that is "
"allocatable", csym->name, &csym->declared_at);
- if (gfc_has_default_initializer (csym->ts.u.derived))
+ if (has_default_initializer (csym->ts.u.derived))
gfc_error_now ("Derived type variable '%s' in COMMON at %L "
"may not have default initializer", csym->name,
&csym->declared_at);
symbol_attribute a;
t = SUCCESS;
- cons = gfc_constructor_first (expr->value.constructor);
+ cons = expr->value.constructor;
/* A constructor may have references if it is the result of substituting a
parameter variable. In this case we just pull out the component we
want. */
&& cons->expr && cons->expr->expr_type == EXPR_NULL)
return SUCCESS;
- for (; comp && cons; comp = comp->next, cons = gfc_constructor_next (cons))
+ for (; comp; comp = comp->next, cons = cons->next)
{
int rank;
if (!gfc_compare_types (&cons->expr->ts, &comp->ts))
{
t = FAILURE;
- if (strcmp (comp->name, "$extends") == 0)
- {
- /* Can afford to be brutal with the $extends initializer.
- The derived type can get lost because it is PRIVATE
- but it is not usage constrained by the standard. */
- cons->expr->ts = comp->ts;
- t = SUCCESS;
- }
- else if (comp->attr.pointer && cons->expr->ts.type != BT_UNKNOWN)
+ 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,
"for pointer component '%s' should be a POINTER or "
"a TARGET", &cons->expr->where, comp->name);
}
-
- /* F2003, C1272 (3). */
- if (gfc_pure (NULL) && cons->expr->expr_type == EXPR_VARIABLE
- && (gfc_impure_variable (cons->expr->symtree->n.sym)
- || gfc_is_coindexed (cons->expr)))
- {
- t = FAILURE;
- gfc_error ("Invalid expression in the derived type constructor for "
- "pointer component '%s' at %L in PURE procedure",
- comp->name, &cons->expr->where);
- }
}
return t;
if (a.allocatable || a.dimension || a.dummy || a.external || a.intrinsic
|| a.optional || a.pointer || a.save || a.target || a.volatile_
|| a.value || a.access != ACCESS_UNKNOWN || a.intent != INTENT_UNKNOWN
- || a.asynchronous || a.codimension)
+ || a.asynchronous)
return 1;
return 0;
gfc_expr *e;
int save_need_full_assumed_size;
gfc_component *comp;
-
+
for (; arg; arg = arg->next)
{
e = arg->expr;
}
}
}
-
- /* Fortran 2008, C1237. */
- if (e->expr_type == EXPR_VARIABLE && gfc_is_coindexed (e)
- && gfc_has_ultimate_pointer (e))
- {
- gfc_error ("Coindexed actual argument at %L with ultimate pointer "
- "component", &e->where);
- return FAILURE;
- }
}
return SUCCESS;
if (expr->symtree && expr->symtree->n.sym)
p = expr->symtree->n.sym->attr.proc;
- if (expr->value.function.isym && expr->value.function.isym->inquiry)
- inquiry_argument = true;
no_formal_args = sym && is_external_proc (sym) && sym->formal == NULL;
-
if (resolve_actual_arglist (expr->value.function.actual,
p, no_formal_args) == FAILURE)
- {
- inquiry_argument = false;
return FAILURE;
- }
- inquiry_argument = false;
-
/* Need to setup the call to the correct c_associated, depending on
the number of cptrs to user gives to compare. */
if (sym && sym->attr.is_iso_c == 1)
{
mpz_t last_value;
- if (ar->dimen_type[i] == DIMEN_STAR)
- {
- gcc_assert (ar->stride[i] == NULL);
- /* This implies [*] as [*:] and [*:3] are not possible. */
- if (ar->start[i] == NULL)
- {
- gcc_assert (ar->end[i] == NULL);
- return SUCCESS;
- }
- }
-
/* Given start, end and stride values, calculate the minimum and
maximum referenced indexes. */
case DIMEN_VECTOR:
break;
- case DIMEN_STAR:
case DIMEN_ELEMENT:
if (compare_bound (ar->start[i], as->lower[i]) == CMP_LT)
{
- if (i < as->rank)
- gfc_warning ("Array reference at %L is out of bounds "
- "(%ld < %ld) in dimension %d", &ar->c_where[i],
- mpz_get_si (ar->start[i]->value.integer),
- mpz_get_si (as->lower[i]->value.integer), i+1);
- else
- gfc_warning ("Array reference at %L is out of bounds "
- "(%ld < %ld) in codimension %d", &ar->c_where[i],
- mpz_get_si (ar->start[i]->value.integer),
- mpz_get_si (as->lower[i]->value.integer),
- i + 1 - as->rank);
+ gfc_warning ("Array reference at %L is out of bounds "
+ "(%ld < %ld) in dimension %d", &ar->c_where[i],
+ mpz_get_si (ar->start[i]->value.integer),
+ mpz_get_si (as->lower[i]->value.integer), i+1);
return SUCCESS;
}
if (compare_bound (ar->start[i], as->upper[i]) == CMP_GT)
{
- if (i < as->rank)
- gfc_warning ("Array reference at %L is out of bounds "
- "(%ld > %ld) in dimension %d", &ar->c_where[i],
- mpz_get_si (ar->start[i]->value.integer),
- mpz_get_si (as->upper[i]->value.integer), i+1);
- else
- gfc_warning ("Array reference at %L is out of bounds "
- "(%ld > %ld) in codimension %d", &ar->c_where[i],
- mpz_get_si (ar->start[i]->value.integer),
- mpz_get_si (as->upper[i]->value.integer),
- i + 1 - as->rank);
+ gfc_warning ("Array reference at %L is out of bounds "
+ "(%ld > %ld) in dimension %d", &ar->c_where[i],
+ mpz_get_si (ar->start[i]->value.integer),
+ mpz_get_si (as->upper[i]->value.integer), i+1);
return SUCCESS;
}
return FAILURE;
}
- /* ar->codimen == 0 is a local array. */
- if (as->corank != ar->codimen && ar->codimen != 0)
- {
- gfc_error ("Coindex rank mismatch in array reference at %L (%d/%d)",
- &ar->where, ar->codimen, as->corank);
- return FAILURE;
- }
-
for (i = 0; i < as->rank; i++)
if (check_dimension (i, ar, as) == FAILURE)
return FAILURE;
- /* Local access has no coarray spec. */
- if (ar->codimen != 0)
- for (i = as->rank; i < as->rank + as->corank; i++)
- {
- if (ar->dimen_type[i] != DIMEN_ELEMENT && !ar->in_allocate)
- {
- gfc_error ("Coindex of codimension %d must be a scalar at %L",
- i + 1 - as->rank, &ar->where);
- return FAILURE;
- }
- if (check_dimension (i, ar, as) == FAILURE)
- return FAILURE;
- }
-
return SUCCESS;
}
/* Resolve one part of an array index. */
-static gfc_try
-gfc_resolve_index_1 (gfc_expr *index, int check_scalar,
- int force_index_integer_kind)
+gfc_try
+gfc_resolve_index (gfc_expr *index, int check_scalar)
{
gfc_typespec ts;
&index->where) == FAILURE)
return FAILURE;
- if ((index->ts.kind != gfc_index_integer_kind
- && force_index_integer_kind)
+ if (index->ts.kind != gfc_index_integer_kind
|| index->ts.type != BT_INTEGER)
{
gfc_clear_ts (&ts);
return SUCCESS;
}
-/* Resolve one part of an array index. */
-
-gfc_try
-gfc_resolve_index (gfc_expr *index, int check_scalar)
-{
- return gfc_resolve_index_1 (index, check_scalar, 1);
-}
-
/* Resolve a dim argument to an intrinsic function. */
gfc_try
int i, check_scalar;
gfc_expr *e;
- for (i = 0; i < ar->dimen + ar->codimen; i++)
+ for (i = 0; i < ar->dimen; i++)
{
check_scalar = ar->dimen_type[i] == DIMEN_RANGE;
- /* Do not force gfc_index_integer_kind for the start. We can
- do fine with any integer kind. This avoids temporary arrays
- created for indexing with a vector. */
- if (gfc_resolve_index_1 (ar->start[i], check_scalar, 0) == FAILURE)
+ if (gfc_resolve_index (ar->start[i], check_scalar) == FAILURE)
return FAILURE;
if (gfc_resolve_index (ar->end[i], check_scalar) == FAILURE)
return FAILURE;
}
}
- if (ar->type == AR_FULL && ar->as->rank == 0)
- ar->type = AR_ELEMENT;
-
/* If the reference type is unknown, figure out what kind it is. */
if (ar->type == AR_UNKNOWN)
if (char_ref->u.ss.start)
start = gfc_copy_expr (char_ref->u.ss.start);
else
- start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+ start = gfc_int_expr (1);
if (char_ref->u.ss.end)
end = gfc_copy_expr (char_ref->u.ss.end);
/* Length = (end - start +1). */
e->ts.u.cl->length = gfc_subtract (end, start);
- e->ts.u.cl->length = gfc_add (e->ts.u.cl->length,
- gfc_get_int_expr (gfc_default_integer_kind,
- NULL, 1));
+ e->ts.u.cl->length = gfc_add (e->ts.u.cl->length, gfc_int_expr (1));
e->ts.u.cl->length->ts.type = BT_INTEGER;
e->ts.u.cl->length->ts.kind = gfc_charlen_int_kind;
switch (ref->u.ar.type)
{
case AR_FULL:
- /* Coarray scalar. */
- if (ref->u.ar.as->rank == 0)
- {
- current_part_dimension = 0;
- break;
- }
- /* Fall through. */
case AR_SECTION:
current_part_dimension = 1;
break;
if (t == SUCCESS && resolve_procedure_expression (e) == FAILURE)
t = FAILURE;
- /* F2008, C617 and C1229. */
- if (!inquiry_argument && (e->ts.type == BT_CLASS || e->ts.type == BT_DERIVED)
- && gfc_is_coindexed (e))
- {
- gfc_ref *ref, *ref2 = NULL;
-
- if (e->ts.type == BT_CLASS)
- {
- gfc_error ("Polymorphic subobject of coindexed object at %L",
- &e->where);
- t = FAILURE;
- }
-
- for (ref = e->ref; ref; ref = ref->next)
- {
- if (ref->type == REF_COMPONENT)
- ref2 = ref;
- if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
- break;
- }
-
- for ( ; ref; ref = ref->next)
- if (ref->type == REF_COMPONENT)
- break;
-
- /* Expression itself is coindexed object. */
- if (ref == NULL)
- {
- gfc_component *c;
- c = ref2 ? ref2->u.c.component : e->symtree->n.sym->components;
- for ( ; c; c = c->next)
- if (c->attr.allocatable && c->ts.type == BT_CLASS)
- {
- gfc_error ("Coindexed object with polymorphic allocatable "
- "subcomponent at %L", &e->where);
- t = FAILURE;
- break;
- }
- }
- }
-
return t;
}
if (op1->ts.u.cl && op1->ts.u.cl->length)
e1 = gfc_copy_expr (op1->ts.u.cl->length);
else if (op1->expr_type == EXPR_CONSTANT)
- e1 = gfc_get_int_expr (gfc_default_integer_kind, NULL,
- op1->value.character.length);
+ e1 = gfc_int_expr (op1->value.character.length);
if (op2->ts.u.cl && op2->ts.u.cl->length)
e2 = gfc_copy_expr (op2->ts.u.cl->length);
else if (op2->expr_type == EXPR_CONSTANT)
- e2 = gfc_get_int_expr (gfc_default_integer_kind, NULL,
- op2->value.character.length);
+ e2 = gfc_int_expr (op2->value.character.length);
e->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
the expression into a call of that binding. */
static gfc_try
-resolve_typebound_generic_call (gfc_expr* e, const char **name)
+resolve_typebound_generic_call (gfc_expr* e)
{
gfc_typebound_proc* genproc;
const char* genname;
if (matches)
{
e->value.compcall.tbp = g->specific;
- /* Pass along the name for CLASS methods, where the vtab
- procedure pointer component has to be referenced. */
- if (name)
- *name = g->specific_st->name;
goto success;
}
}
/* Resolve a call to a type-bound subroutine. */
static gfc_try
-resolve_typebound_call (gfc_code* c, const char **name)
+resolve_typebound_call (gfc_code* c)
{
gfc_actual_arglist* newactual;
gfc_symtree* target;
if (check_typebound_baseobject (c->expr1) == FAILURE)
return FAILURE;
- /* Pass along the name for CLASS methods, where the vtab
- procedure pointer component has to be referenced. */
- if (name)
- *name = c->expr1->value.compcall.name;
-
- if (resolve_typebound_generic_call (c->expr1, name) == FAILURE)
+ if (resolve_typebound_generic_call (c->expr1) == FAILURE)
return FAILURE;
/* Transform into an ordinary EXEC_CALL for now. */
}
-/* Resolve a component-call expression. */
+/* Resolve a component-call expression. This originally was intended
+ only to see functions. However, it is convenient to use it in
+ resolving subroutine class methods, since we do not have to add a
+ gfc_code each time. */
static gfc_try
-resolve_compcall (gfc_expr* e, const char **name)
+resolve_compcall (gfc_expr* e, bool fcn, bool class_members)
{
gfc_actual_arglist* newactual;
gfc_symtree* target;
/* Check that's really a FUNCTION. */
- if (!e->value.compcall.tbp->function)
+ if (fcn && !e->value.compcall.tbp->function)
{
gfc_error ("'%s' at %L should be a FUNCTION",
e->value.compcall.name, &e->where);
return FAILURE;
}
+ else if (!fcn && !e->value.compcall.tbp->subroutine)
+ {
+ /* To resolve class member calls, we borrow this bit
+ of code to select the specific procedures. */
+ gfc_error ("'%s' at %L should be a SUBROUTINE",
+ e->value.compcall.name, &e->where);
+ return FAILURE;
+ }
/* These must not be assign-calls! */
gcc_assert (!e->value.compcall.assign);
if (check_typebound_baseobject (e) == FAILURE)
return FAILURE;
- /* Pass along the name for CLASS methods, where the vtab
- procedure pointer component has to be referenced. */
- if (name)
- *name = e->value.compcall.name;
-
- if (resolve_typebound_generic_call (e, name) == FAILURE)
+ if (resolve_typebound_generic_call (e) == FAILURE)
return FAILURE;
gcc_assert (!e->value.compcall.tbp->is_generic);
e->value.function.actual = newactual;
e->value.function.name = NULL;
e->value.function.esym = target->n.sym;
+ e->value.function.class_esym = NULL;
e->value.function.isym = NULL;
e->symtree = target;
e->ts = target->n.sym->ts;
e->expr_type = EXPR_FUNCTION;
- /* Resolution is not necessary if this is a class subroutine; this
- function only has to identify the specific proc. Resolution of
- the call will be done next in resolve_typebound_call. */
- return gfc_resolve_expr (e);
+ /* Resolution is not necessary when constructing component calls
+ for class members, since this must only be done for the
+ declared type, which is done afterwards. */
+ return !class_members ? gfc_resolve_expr (e) : SUCCESS;
+}
+
+
+/* Resolve a typebound call for the members in a class. This group of
+ functions implements dynamic dispatch in the provisional version
+ of f03 OOP. As soon as vtables are in place and contain pointers
+ to methods, this will no longer be necessary. */
+static gfc_expr *list_e;
+static void check_class_members (gfc_symbol *);
+static gfc_try class_try;
+static bool fcn_flag;
+
+
+static void
+check_members (gfc_symbol *derived)
+{
+ if (derived->attr.flavor == FL_DERIVED)
+ check_class_members (derived);
+}
+
+
+static void
+check_class_members (gfc_symbol *derived)
+{
+ gfc_expr *e;
+ gfc_symtree *tbp;
+ gfc_class_esym_list *etmp;
+
+ e = gfc_copy_expr (list_e);
+
+ tbp = gfc_find_typebound_proc (derived, &class_try,
+ e->value.compcall.name,
+ false, &e->where);
+
+ if (tbp == NULL)
+ {
+ gfc_error ("no typebound available procedure named '%s' at %L",
+ e->value.compcall.name, &e->where);
+ return;
+ }
+
+ /* If we have to match a passed class member, force the actual
+ expression to have the correct type. */
+ if (!tbp->n.tb->nopass)
+ {
+ if (e->value.compcall.base_object == NULL)
+ e->value.compcall.base_object = extract_compcall_passed_object (e);
+
+ if (!derived->attr.abstract)
+ {
+ e->value.compcall.base_object->ts.type = BT_DERIVED;
+ e->value.compcall.base_object->ts.u.derived = derived;
+ }
+ }
+
+ e->value.compcall.tbp = tbp->n.tb;
+ e->value.compcall.name = tbp->name;
+
+ /* Let the original expresssion catch the assertion in
+ resolve_compcall, since this flag does not appear to be reset or
+ copied in some systems. */
+ e->value.compcall.assign = 0;
+
+ /* Do the renaming, PASSing, generic => specific and other
+ good things for each class member. */
+ class_try = (resolve_compcall (e, fcn_flag, true) == SUCCESS)
+ ? class_try : FAILURE;
+
+ /* Now transfer the found symbol to the esym list. */
+ if (class_try == SUCCESS)
+ {
+ etmp = list_e->value.function.class_esym;
+ list_e->value.function.class_esym
+ = gfc_get_class_esym_list();
+ list_e->value.function.class_esym->next = etmp;
+ list_e->value.function.class_esym->derived = derived;
+ list_e->value.function.class_esym->esym
+ = e->value.function.esym;
+ }
+
+ gfc_free_expr (e);
+
+ /* Burrow down into grandchildren types. */
+ if (derived->f2k_derived)
+ gfc_traverse_ns (derived->f2k_derived, check_members);
+}
+
+
+/* Eliminate esym_lists where all the members point to the
+ typebound procedure of the declared type; ie. one where
+ type selection has no effect.. */
+static void
+resolve_class_esym (gfc_expr *e)
+{
+ gfc_class_esym_list *p, *q;
+ bool empty = true;
+
+ gcc_assert (e && e->expr_type == EXPR_FUNCTION);
+
+ p = e->value.function.class_esym;
+ if (p == NULL)
+ return;
+
+ for (; p; p = p->next)
+ empty = empty && (e->value.function.esym == p->esym);
+
+ if (empty)
+ {
+ p = e->value.function.class_esym;
+ for (; p; p = q)
+ {
+ q = p->next;
+ gfc_free (p);
+ }
+ e->value.function.class_esym = NULL;
+ }
+}
+
+
+/* Generate an expression for the hash value, given the reference to
+ the class of the final expression (class_ref), the base of the
+ full reference list (new_ref), the declared type and the class
+ object (st). */
+static gfc_expr*
+hash_value_expr (gfc_ref *class_ref, gfc_ref *new_ref, gfc_symtree *st)
+{
+ gfc_expr *hash_value;
+
+ /* Build an expression for the correct hash_value; ie. that of the last
+ CLASS reference. */
+ if (class_ref)
+ {
+ class_ref->next = NULL;
+ }
+ else
+ {
+ gfc_free_ref_list (new_ref);
+ new_ref = NULL;
+ }
+ hash_value = gfc_get_expr ();
+ hash_value->expr_type = EXPR_VARIABLE;
+ hash_value->symtree = st;
+ hash_value->symtree->n.sym->refs++;
+ hash_value->ref = new_ref;
+ gfc_add_component_ref (hash_value, "$vptr");
+ gfc_add_component_ref (hash_value, "$hash");
+
+ return hash_value;
}
}
-/* Resolve a typebound function, or 'method'. First separate all
- the non-CLASS references by calling resolve_compcall directly. */
+/* Resolve the argument expressions so that any arguments expressions
+ that include class methods are resolved before the current call.
+ This is necessary because of the static variables used in CLASS
+ method resolution. */
+static void
+resolve_arg_exprs (gfc_actual_arglist *arg)
+{
+ /* Resolve the actual arglist expressions. */
+ for (; arg; arg = arg->next)
+ {
+ if (arg->expr)
+ gfc_resolve_expr (arg->expr);
+ }
+}
+
+
+/* Resolve a typebound function, or 'method'. First separate all
+ the non-CLASS references by calling resolve_compcall directly.
+ Then treat the CLASS references by resolving for each of the class
+ members in turn. */
static gfc_try
resolve_typebound_function (gfc_expr* e)
{
- gfc_symbol *declared;
- gfc_component *c;
+ gfc_symbol *derived, *declared;
gfc_ref *new_ref;
gfc_ref *class_ref;
gfc_symtree *st;
- const char *name;
- const char *genname;
- gfc_typespec ts;
st = e->symtree;
if (st == NULL)
- return resolve_compcall (e, NULL);
+ return resolve_compcall (e, true, false);
/* Get the CLASS declared type. */
declared = get_declared_from_expr (&class_ref, &new_ref, e);
/* Weed out cases of the ultimate component being a derived type. */
if ((class_ref && class_ref->u.c.component->ts.type == BT_DERIVED)
- || (!class_ref && st->n.sym->ts.type != BT_CLASS))
+ || (!class_ref && st->n.sym->ts.type != BT_CLASS))
{
gfc_free_ref_list (new_ref);
- return resolve_compcall (e, NULL);
+ return resolve_compcall (e, true, false);
}
- c = gfc_find_component (declared, "$data", true, true);
- declared = c->ts.u.derived;
+ /* Resolve the argument expressions, */
+ resolve_arg_exprs (e->value.function.actual);
- /* Keep the generic name so that the vtab reference can be made. */
- genname = NULL;
- if (e->value.compcall.tbp->is_generic)
- genname = e->value.compcall.name;
+ /* Get the data component, which is of the declared type. */
+ derived = declared->components->ts.u.derived;
- /* Treat the call as if it is a typebound procedure, in order to roll
- out the correct name for the specific function. */
- resolve_compcall (e, &name);
- ts = e->ts;
+ /* Resolve the function call for each member of the class. */
+ class_try = SUCCESS;
+ fcn_flag = true;
+ list_e = gfc_copy_expr (e);
+ check_class_members (derived);
- /* Then convert the expression to a procedure pointer component call. */
- e->value.function.esym = NULL;
- e->symtree = st;
+ class_try = (resolve_compcall (e, true, false) == SUCCESS)
+ ? class_try : FAILURE;
- if (class_ref)
- {
- gfc_free_ref_list (class_ref->next);
- e->ref = new_ref;
- }
+ /* Transfer the class list to the original expression. Note that
+ the class_esym list is cleaned up in trans-expr.c, as the calls
+ are translated. */
+ e->value.function.class_esym = list_e->value.function.class_esym;
+ list_e->value.function.class_esym = NULL;
+ gfc_free_expr (list_e);
- /* '$vptr' points to the vtab, which contains the procedure pointers. */
- gfc_add_component_ref (e, "$vptr");
- if (genname)
- {
- /* A generic procedure needs the subsidiary vtabs and vtypes for
- the specific procedures to have been build. */
- gfc_symbol *vtab;
- vtab = gfc_find_derived_vtab (declared, true);
- gcc_assert (vtab);
- gfc_add_component_ref (e, genname);
- }
- gfc_add_component_ref (e, name);
+ resolve_class_esym (e);
- /* Recover the typespec for the expression. This is really only
- necessary for generic procedures, where the additional call
- to gfc_add_component_ref seems to throw the collection of the
- correct typespec. */
- e->ts = ts;
- return SUCCESS;
+ /* More than one typebound procedure so transmit an expression for
+ the hash_value as the selector. */
+ if (e->value.function.class_esym != NULL)
+ e->value.function.class_esym->hash_value
+ = hash_value_expr (class_ref, new_ref, st);
+
+ return class_try;
}
-/* Resolve a typebound subroutine, or 'method'. First separate all
- the non-CLASS references by calling resolve_typebound_call
- directly. */
+/* Resolve a typebound subroutine, or 'method'. First separate all
+ the non-CLASS references by calling resolve_typebound_call directly.
+ Then treat the CLASS references by resolving for each of the class
+ members in turn. */
static gfc_try
resolve_typebound_subroutine (gfc_code *code)
{
- gfc_symbol *declared;
- gfc_component *c;
+ gfc_symbol *derived, *declared;
gfc_ref *new_ref;
gfc_ref *class_ref;
gfc_symtree *st;
- const char *genname;
- const char *name;
- gfc_typespec ts;
st = code->expr1->symtree;
if (st == NULL)
- return resolve_typebound_call (code, NULL);
+ return resolve_typebound_call (code);
/* Get the CLASS declared type. */
declared = get_declared_from_expr (&class_ref, &new_ref, code->expr1);
/* Weed out cases of the ultimate component being a derived type. */
if ((class_ref && class_ref->u.c.component->ts.type == BT_DERIVED)
- || (!class_ref && st->n.sym->ts.type != BT_CLASS))
+ || (!class_ref && st->n.sym->ts.type != BT_CLASS))
{
gfc_free_ref_list (new_ref);
- return resolve_typebound_call (code, NULL);
+ return resolve_typebound_call (code);
}
- c = gfc_find_component (declared, "$data", true, true);
- declared = c->ts.u.derived;
+ /* Resolve the argument expressions, */
+ resolve_arg_exprs (code->expr1->value.compcall.actual);
- /* Keep the generic name so that the vtab reference can be made. */
- genname = NULL;
- if (code->expr1->value.compcall.tbp->is_generic)
- genname = code->expr1->value.compcall.name;
+ /* Get the data component, which is of the declared type. */
+ derived = declared->components->ts.u.derived;
- resolve_typebound_call (code, &name);
- ts = code->expr1->ts;
+ class_try = SUCCESS;
+ fcn_flag = false;
+ list_e = gfc_copy_expr (code->expr1);
+ check_class_members (derived);
- /* Then convert the expression to a procedure pointer component call. */
- code->expr1->value.function.esym = NULL;
- code->expr1->symtree = st;
+ class_try = (resolve_typebound_call (code) == SUCCESS)
+ ? class_try : FAILURE;
- if (class_ref)
- {
- gfc_free_ref_list (class_ref->next);
- code->expr1->ref = new_ref;
- }
+ /* Transfer the class list to the original expression. Note that
+ the class_esym list is cleaned up in trans-expr.c, as the calls
+ are translated. */
+ code->expr1->value.function.class_esym
+ = list_e->value.function.class_esym;
+ list_e->value.function.class_esym = NULL;
+ gfc_free_expr (list_e);
- /* '$vptr' points to the vtab, which contains the procedure pointers. */
- gfc_add_component_ref (code->expr1, "$vptr");
- if (genname)
- {
- /* A generic procedure needs the subsidiary vtabs and vtypes for
- the specific procedures to have been build. */
- gfc_symbol *vtab;
- vtab = gfc_find_derived_vtab (declared, true);
- gcc_assert (vtab);
- gfc_add_component_ref (code->expr1, genname);
- }
- gfc_add_component_ref (code->expr1, name);
+ resolve_class_esym (code->expr1);
- /* Recover the typespec for the expression. This is really only
- necessary for generic procedures, where the additional call
- to gfc_add_component_ref seems to throw the collection of the
- correct typespec. */
- code->expr1->ts = ts;
- return SUCCESS;
+ /* More than one typebound procedure so transmit an expression for
+ the hash_value as the selector. */
+ if (code->expr1->value.function.class_esym != NULL)
+ code->expr1->value.function.class_esym->hash_value
+ = hash_value_expr (class_ref, new_ref, st);
+
+ return class_try;
}
/* Traverse the constructor looking for variables that are flavor
parameter. Parameters must be expanded since they are fully used at
compile time. */
- con = gfc_constructor_first (e->value.constructor);
- for (; con; con = gfc_constructor_next (con))
+ for (con = e->value.constructor; con; con = con->next)
{
if (con->expr->expr_type == EXPR_VARIABLE
- && con->expr->symtree
- && (con->expr->symtree->n.sym->attr.flavor == FL_PARAMETER
+ && con->expr->symtree
+ && (con->expr->symtree->n.sym->attr.flavor == FL_PARAMETER
|| con->expr->symtree->n.sym->attr.flavor == FL_VARIABLE))
return true;
if (con->expr->expr_type == EXPR_ARRAY
- && gfc_is_expandable_expr (con->expr))
+ && gfc_is_expandable_expr (con->expr))
return true;
}
}
gfc_resolve_expr (gfc_expr *e)
{
gfc_try t;
- bool inquiry_save;
if (e == NULL)
return SUCCESS;
- /* inquiry_argument only applies to variables. */
- inquiry_save = inquiry_argument;
- if (e->expr_type != EXPR_VARIABLE)
- inquiry_argument = false;
-
switch (e->expr_type)
{
case EXPR_OP:
if (e->ts.type == BT_CHARACTER && t == SUCCESS && !e->ts.u.cl)
fixup_charlen (e);
- inquiry_argument = inquiry_save;
-
return t;
}
resolve_allocate_expr (gfc_expr *e, gfc_code *code)
{
int i, pointer, allocatable, dimension, check_intent_in, is_abstract;
- int codimension;
symbol_attribute attr;
gfc_ref *ref, *ref2;
gfc_array_ref *ar;
/* Check INTENT(IN), unless the object is a sub-component of a pointer. */
check_intent_in = 1;
- /* Mark the ultimost array component as being in allocate to allow DIMEN_STAR
- checking of coarrays. */
- for (ref = e->ref; ref; ref = ref->next)
- if (ref->next == NULL)
- break;
-
- if (ref && ref->type == REF_ARRAY)
- ref->u.ar.in_allocate = true;
-
if (gfc_resolve_expr (e) == FAILURE)
- goto failure;
+ return FAILURE;
/* Make sure the expression is allocatable or a pointer. If it is
pointer, the next-to-last reference must be a pointer. */
attr = gfc_expr_attr (e);
pointer = attr.pointer;
dimension = attr.dimension;
- codimension = attr.codimension;
}
else
{
allocatable = sym->ts.u.derived->components->attr.allocatable;
pointer = sym->ts.u.derived->components->attr.pointer;
dimension = sym->ts.u.derived->components->attr.dimension;
- codimension = sym->ts.u.derived->components->attr.codimension;
is_abstract = sym->ts.u.derived->components->attr.abstract;
}
else
allocatable = sym->attr.allocatable;
pointer = sym->attr.pointer;
dimension = sym->attr.dimension;
- codimension = sym->attr.codimension;
}
for (ref = e->ref; ref; ref2 = ref, ref = ref->next)
break;
case REF_COMPONENT:
- /* F2008, C644. */
- if (gfc_is_coindexed (e))
- {
- gfc_error ("Coindexed allocatable object at %L",
- &e->where);
- goto failure;
- }
-
c = ref->u.c.component;
if (c->ts.type == BT_CLASS)
{
allocatable = c->ts.u.derived->components->attr.allocatable;
pointer = c->ts.u.derived->components->attr.pointer;
dimension = c->ts.u.derived->components->attr.dimension;
- codimension = c->ts.u.derived->components->attr.codimension;
is_abstract = c->ts.u.derived->components->attr.abstract;
}
else
allocatable = c->attr.allocatable;
pointer = c->attr.pointer;
dimension = c->attr.dimension;
- codimension = c->attr.codimension;
is_abstract = c->attr.abstract;
}
break;
{
gfc_error ("Allocate-object at %L must be ALLOCATABLE or a POINTER",
&e->where);
- goto failure;
+ return FAILURE;
}
/* Some checks for the SOURCE tag. */
{
gfc_error ("Type of entity at %L is type incompatible with "
"source-expr at %L", &e->where, &code->expr3->where);
- goto failure;
+ return FAILURE;
}
/* Check F03:C632 and restriction following Note 6.18. */
if (code->expr3->rank > 0
&& conformable_arrays (code->expr3, e) == FAILURE)
- goto failure;
+ return FAILURE;
/* Check F03:C633. */
if (code->expr3->ts.kind != e->ts.kind)
gfc_error ("The allocate-object at %L and the source-expr at %L "
"shall have the same kind type parameter",
&e->where, &code->expr3->where);
- goto failure;
+ return FAILURE;
}
}
else if (is_abstract&& code->ext.alloc.ts.type == BT_UNKNOWN)
gcc_assert (e->ts.type == BT_CLASS);
gfc_error ("Allocating %s of ABSTRACT base type at %L requires a "
"type-spec or SOURCE=", sym->name, &e->where);
- goto failure;
+ return FAILURE;
}
if (check_intent_in && sym->attr.intent == INTENT_IN)
{
gfc_error ("Cannot allocate INTENT(IN) variable '%s' at %L",
sym->name, &e->where);
- goto failure;
+ return FAILURE;
}
if (!code->expr3)
}
}
- if (pointer || (dimension == 0 && codimension == 0))
- goto success;
+ if (pointer || dimension == 0)
+ return SUCCESS;
/* Make sure the next-to-last reference node is an array specification. */
- if (ref2 == NULL || ref2->type != REF_ARRAY || ref2->u.ar.type == AR_FULL
- || (dimension && ref2->u.ar.dimen == 0))
+ if (ref2 == NULL || ref2->type != REF_ARRAY || ref2->u.ar.type == AR_FULL)
{
gfc_error ("Array specification required in ALLOCATE statement "
"at %L", &e->where);
- goto failure;
+ return FAILURE;
}
/* Make sure that the array section reference makes sense in the
ar = &ref2->u.ar;
- if (codimension && ar->codimen == 0)
- {
- gfc_error ("Coarray specification required in ALLOCATE statement "
- "at %L", &e->where);
- goto failure;
- }
-
for (i = 0; i < ar->dimen; i++)
{
if (ref2->u.ar.type == AR_ELEMENT)
case DIMEN_UNKNOWN:
case DIMEN_VECTOR:
- case DIMEN_STAR:
gfc_error ("Bad array specification in ALLOCATE statement at %L",
&e->where);
- goto failure;
+ return FAILURE;
}
check_symbols:
+
for (a = code->ext.alloc.list; a; a = a->next)
{
sym = a->expr->symtree->n.sym;
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);
- goto failure;
- }
- }
- }
-
- for (i = ar->dimen; i < ar->codimen + ar->dimen; i++)
- {
- if (ar->dimen_type[i] == DIMEN_ELEMENT
- || ar->dimen_type[i] == DIMEN_RANGE)
- {
- if (i == (ar->dimen + ar->codimen - 1))
- {
- gfc_error ("Expected '*' in coindex specification in ALLOCATE "
- "statement at %L", &e->where);
- goto failure;
+ return FAILURE;
}
- break;
}
-
- if (ar->dimen_type[i] == DIMEN_STAR && i == (ar->dimen + ar->codimen - 1)
- && ar->stride[i] == NULL)
- break;
-
- gfc_error ("Bad coarray specification in ALLOCATE statement at %L",
- &e->where);
- goto failure;
}
- if (codimension && ar->as->rank == 0)
- {
- gfc_error ("Sorry, allocatable scalar coarrays are not yet supported "
- "at %L", &e->where);
- goto failure;
- }
-
-success:
return SUCCESS;
-
-failure:
- return FAILURE;
}
static void
return FAILURE;
}
- /* Convert the case value kind to that of case expression kind,
- if needed */
-
+ /* Convert the case value kind to that of case expression kind, if needed.
+ FIXME: Should a warning be issued? */
if (e->ts.kind != case_expr->ts.kind)
gfc_convert_type_warn (e, &case_expr->ts, 2, 0);
return;
}
-
- /* Raise a warning if an INTEGER case value exceeds the range of
- the case-expr. Later, all expressions will be promoted to the
- largest kind of all case-labels. */
-
- if (type == BT_INTEGER)
- for (body = code->block; body; body = body->block)
- for (cp = body->ext.case_list; cp; cp = cp->next)
- {
- if (cp->low
- && gfc_check_integer_range (cp->low->value.integer,
- case_expr->ts.kind) != ARITH_OK)
- gfc_warning ("Expression in CASE statement at %L is "
- "not in the range of %s", &cp->low->where,
- gfc_typename (&case_expr->ts));
-
- if (cp->high
- && cp->low != cp->high
- && gfc_check_integer_range (cp->high->value.integer,
- case_expr->ts.kind) != ARITH_OK)
- gfc_warning ("Expression in CASE statement at %L is "
- "not in the range of %s", &cp->high->where,
- gfc_typename (&case_expr->ts));
- }
-
/* PR 19168 has a long discussion concerning a mismatch of the kinds
of the SELECT CASE expression and its CASE values. Walk the lists
of case values, and if we find a mismatch, promote case_expr to
&& gfc_compare_expr (cp->low, cp->high, INTRINSIC_GT) > 0)
continue;
+ /* FIXME: Should a warning be issued? */
if (cp->low != NULL
&& case_expr->ts.kind != gfc_kind_max(case_expr, cp->low))
gfc_convert_type_warn (case_expr, &cp->low->ts, 2, 0);
/* Deal with single value cases and case ranges. Errors are
issued from the validation function. */
- if (validate_case_label_expr (cp->low, case_expr) != SUCCESS
- || validate_case_label_expr (cp->high, case_expr) != SUCCESS)
+ if(validate_case_label_expr (cp->low, case_expr) != SUCCESS
+ || validate_case_label_expr (cp->high, case_expr) != SUCCESS)
{
t = FAILURE;
break;
value = cp->low->value.logical == 0 ? 2 : 1;
if (value & seen_logical)
{
- gfc_error ("Constant logical value in CASE statement "
+ gfc_error ("constant logical value in CASE statement "
"is repeated at %L",
&cp->low->where);
t = FAILURE;
ns = code->ext.ns;
gfc_resolve (ns);
- /* Check for F03:C813. */
- if (code->expr1->ts.type != BT_CLASS
- && !(code->expr2 && code->expr2->ts.type == BT_CLASS))
- {
- gfc_error ("Selector shall be polymorphic in SELECT TYPE statement "
- "at %L", &code->loc);
- return;
- }
-
if (code->expr2)
- {
- if (code->expr1->symtree->n.sym->attr.untyped)
- code->expr1->symtree->n.sym->ts = code->expr2->ts;
- selector_type = code->expr2->ts.u.derived->components->ts.u.derived;
- }
+ selector_type = code->expr2->ts.u.derived->components->ts.u.derived;
else
selector_type = code->expr1->ts.u.derived->components->ts.u.derived;
for (body = code->block; body; body = body->block)
{
c = body->ext.case_list;
-
+
if (c->ts.type == BT_DERIVED)
- c->low = c->high = gfc_get_int_expr (gfc_default_integer_kind, NULL,
- c->ts.u.derived->hash_value);
-
+ c->low = c->high = gfc_int_expr (c->ts.u.derived->hash_value);
else if (c->ts.type == BT_UNKNOWN)
continue;
-
+
/* Assign temporary to selector. */
if (c->ts.type == BT_CLASS)
sprintf (name, "tmp$class$%s", c->ts.u.derived->name);
tail->next = NULL;
default_case = tail;
}
-
+
/* More than one CLASS IS block? */
if (class_is->block)
{
new_st->expr1->value.function.actual = gfc_get_actual_arglist ();
new_st->expr1->value.function.actual->expr = gfc_get_variable_expr (code->expr1->symtree);
gfc_add_component_ref (new_st->expr1->value.function.actual->expr, "$vptr");
- vtab = gfc_find_derived_vtab (body->ext.case_list->ts.u.derived, true);
+ vtab = gfc_find_derived_vtab (body->ext.case_list->ts.u.derived);
st = gfc_find_symtree (vtab->ns->sym_root, vtab->name);
new_st->expr1->value.function.actual->next = gfc_get_actual_arglist ();
new_st->expr1->value.function.actual->next->expr = gfc_get_variable_expr (st);
}
}
-
-static void
-resolve_sync (gfc_code *code)
-{
- /* Check imageset. The * case matches expr1 == NULL. */
- if (code->expr1)
- {
- if (code->expr1->ts.type != BT_INTEGER || code->expr1->rank > 1)
- gfc_error ("Imageset argument at %L must be a scalar or rank-1 "
- "INTEGER expression", &code->expr1->where);
- if (code->expr1->expr_type == EXPR_CONSTANT && code->expr1->rank == 0
- && mpz_cmp_si (code->expr1->value.integer, 1) < 0)
- gfc_error ("Imageset argument at %L must between 1 and num_images()",
- &code->expr1->where);
- else if (code->expr1->expr_type == EXPR_ARRAY
- && gfc_simplify_expr (code->expr1, 0) == SUCCESS)
- {
- gfc_constructor *cons;
- cons = gfc_constructor_first (code->expr1->value.constructor);
- for (; cons; cons = gfc_constructor_next (cons))
- if (cons->expr->expr_type == EXPR_CONSTANT
- && mpz_cmp_si (cons->expr->value.integer, 1) < 0)
- gfc_error ("Imageset argument at %L must between 1 and "
- "num_images()", &cons->expr->where);
- }
- }
-
- /* Check STAT. */
- if (code->expr2
- && (code->expr2->ts.type != BT_INTEGER || code->expr2->rank != 0
- || code->expr2->expr_type != EXPR_VARIABLE))
- gfc_error ("STAT= argument at %L must be a scalar INTEGER variable",
- &code->expr2->where);
-
- /* Check ERRMSG. */
- if (code->expr3
- && (code->expr3->ts.type != BT_CHARACTER || code->expr3->rank != 0
- || code->expr3->expr_type != EXPR_VARIABLE))
- gfc_error ("ERRMSG= argument at %L must be a scalar CHARACTER variable",
- &code->expr3->where);
-}
-
-
/* Given a branch to a label, see if the branch is conforming.
The code node describes where the branch is located. */
the bitmap reachable_labels. */
if (bitmap_bit_p (cs_base->reachable_labels, label->value))
- {
- /* Check now whether there is a CRITICAL construct; if so, check
- whether the label is still visible outside of the CRITICAL block,
- which is invalid. */
- for (stack = cs_base; stack; stack = stack->prev)
- if (stack->current->op == EXEC_CRITICAL
- && bitmap_bit_p (stack->reachable_labels, label->value))
- gfc_error ("GOTO statement at %L leaves CRITICAL construct for label"
- " at %L", &code->loc, &label->where);
-
- return;
- }
+ return;
/* Step four: If we haven't found the label in the bitmap, it may
still be the label of the END of the enclosing block, in which
case we find it by going up the code_stack. */
for (stack = cs_base; stack; stack = stack->prev)
- {
- if (stack->current->next && stack->current->next->here == label)
- break;
- if (stack->current->op == EXEC_CRITICAL)
- {
- /* Note: A label at END CRITICAL does not leave the CRITICAL
- construct as END CRITICAL is still part of it. */
- gfc_error ("GOTO statement at %L leaves CRITICAL construct for label"
- " at %L", &code->loc, &label->where);
- return;
- }
- }
+ if (stack->current->next && stack->current->next->here == label)
+ break;
if (stack)
{
case EXEC_FORALL:
case EXEC_DO:
case EXEC_DO_WHILE:
- case EXEC_CRITICAL:
case EXEC_READ:
case EXEC_WRITE:
case EXEC_IOLENGTH:
and rhs is the same symbol as the lhs. */
if ((*rhsptr)->expr_type == EXPR_VARIABLE
&& (*rhsptr)->symtree->n.sym->ts.type == BT_DERIVED
- && gfc_has_default_initializer ((*rhsptr)->symtree->n.sym->ts.u.derived)
+ && has_default_initializer ((*rhsptr)->symtree->n.sym->ts.u.derived)
&& (lhs->symtree->n.sym == (*rhsptr)->symtree->n.sym))
*rhsptr = gfc_get_parentheses (*rhsptr);
if (lhs->ts.type == BT_DERIVED
&& lhs->expr_type == EXPR_VARIABLE
&& lhs->ts.u.derived->attr.pointer_comp
- && rhs->expr_type == EXPR_VARIABLE
- && (gfc_impure_variable (rhs->symtree->n.sym)
- || gfc_is_coindexed (rhs)))
- {
- /* F2008, C1283. */
- if (gfc_is_coindexed (rhs))
- gfc_error ("Coindexed expression at %L is assigned to "
- "a derived type variable with a POINTER "
- "component in a PURE procedure",
- &rhs->where);
- else
- gfc_error ("The impure variable at %L is assigned to "
- "a derived type variable with a POINTER "
- "component in a PURE procedure (12.6)",
- &rhs->where);
- return rval;
- }
-
- /* Fortran 2008, C1283. */
- if (gfc_is_coindexed (lhs))
+ && gfc_impure_variable (rhs->symtree->n.sym))
{
- gfc_error ("Assignment to coindexed variable at %L in a PURE "
- "procedure", &rhs->where);
+ gfc_error ("The impure variable at %L is assigned to "
+ "a derived type variable with a POINTER "
+ "component in a PURE procedure (12.6)",
+ &rhs->where);
return rval;
}
}
/* F03:7.4.1.2. */
- /* FIXME: Valid in Fortran 2008, unless the LHS is both polymorphic
- and coindexed; cf. F2008, 7.2.1.2 and PR 43366. */
if (lhs->ts.type == BT_CLASS)
{
gfc_error ("Variable must not be polymorphic in assignment at %L",
return false;
}
- /* F2008, Section 7.2.1.2. */
- if (gfc_is_coindexed (lhs) && gfc_has_ultimate_allocatable (lhs))
- {
- gfc_error ("Coindexed variable must not be have an allocatable ultimate "
- "component in assignment at %L", &lhs->where);
- return false;
- }
-
gfc_check_assign (lhs, rhs, 1);
return false;
}
case EXEC_CYCLE:
case EXEC_PAUSE:
case EXEC_STOP:
- case EXEC_ERROR_STOP:
case EXEC_EXIT:
case EXEC_CONTINUE:
case EXEC_DT_END:
case EXEC_ASSIGN_CALL:
- case EXEC_CRITICAL:
- break;
-
- case EXEC_SYNC_ALL:
- case EXEC_SYNC_IMAGES:
- case EXEC_SYNC_MEMORY:
- resolve_sync (code);
break;
case EXEC_ENTRY:
gfc_warning_now ("CHARACTER variable at %L has negative length %d,"
" the length has been set to zero",
&cl->length->where, i);
- gfc_replace_expr (cl->length,
- gfc_get_int_expr (gfc_default_integer_kind, NULL, 0));
+ gfc_replace_expr (cl->length, gfc_int_expr (0));
}
/* Check that the character length is not too large. */
/* Unfortunately, !gfc_is_compile_time_shape hits a legal case that
has not been simplified; parameter array references. Do the
simplification now. */
- for (i = 0; i < sym->as->rank + sym->as->corank; i++)
+ for (i = 0; i < sym->as->rank; i++)
{
e = sym->as->lower[i];
if (e && (resolve_index_expr (e) == FAILURE
|| !gfc_is_constant_expr (e)))
not_constant = true;
+
e = sym->as->upper[i];
if (e && (resolve_index_expr (e) == FAILURE
|| !gfc_is_constant_expr (e)))
return NULL;
/* Now we'll try to build an initializer expression. */
- init_expr = gfc_get_constant_expr (sym->ts.type, sym->ts.kind,
- &sym->declared_at);
-
+ init_expr = gfc_get_expr ();
+ init_expr->expr_type = EXPR_CONSTANT;
+ init_expr->ts.type = sym->ts.type;
+ init_expr->ts.kind = sym->ts.kind;
+ init_expr->where = sym->declared_at;
+
/* We will only initialize integers, reals, complex, logicals, and
characters, and only if the corresponding command-line flags
were set. Otherwise, we free init_expr and return null. */
return FAILURE;
}
}
-
- /* Constraints on polymorphic variables. */
- if (sym->ts.type == BT_CLASS && !(sym->result && sym->result != sym))
- {
- /* F03:C502. */
- if (!gfc_type_is_extensible (sym->ts.u.derived->components->ts.u.derived))
- {
- gfc_error ("Type '%s' of CLASS variable '%s' at %L is not extensible",
- sym->ts.u.derived->components->ts.u.derived->name,
- sym->name, &sym->declared_at);
- return FAILURE;
- }
-
- /* F03:C509. */
- /* Assume that use associated symbols were checked in the module ns. */
- if (!sym->attr.class_ok && !sym->attr.use_assoc)
- {
- gfc_error ("CLASS variable '%s' at %L must be dummy, allocatable "
- "or pointer", sym->name, &sym->declared_at);
- return FAILURE;
- }
- }
-
return SUCCESS;
}
or POINTER attribute, the object shall have the SAVE attribute."
The check for initializers is performed with
- gfc_has_default_initializer because gfc_default_initializer generates
+ has_default_initializer because gfc_default_initializer generates
a hidden default for allocatable components. */
if (!(sym->value || no_init_flag) && sym->ns->proc_name
&& sym->ns->proc_name->attr.flavor == FL_MODULE
&& !sym->ns->save_all && !sym->attr.save
&& !sym->attr.pointer && !sym->attr.allocatable
- && gfc_has_default_initializer (sym->ts.u.derived)
+ && has_default_initializer (sym->ts.u.derived)
&& gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Implied SAVE for "
"module variable '%s' at %L, needed due to "
"the default initialization", sym->name,
&sym->declared_at) == FAILURE)
return FAILURE;
+ if (sym->ts.type == BT_CLASS)
+ {
+ /* C502. */
+ if (!gfc_type_is_extensible (sym->ts.u.derived->components->ts.u.derived))
+ {
+ gfc_error ("Type '%s' of CLASS variable '%s' at %L is not extensible",
+ sym->ts.u.derived->components->ts.u.derived->name,
+ sym->name, &sym->declared_at);
+ return FAILURE;
+ }
+
+ /* C509. */
+ /* Assume that use associated symbols were checked in the module ns. */
+ if (!sym->attr.class_ok && !sym->attr.use_assoc)
+ {
+ gfc_error ("CLASS variable '%s' at %L must be dummy, allocatable "
+ "or pointer", sym->name, &sym->declared_at);
+ return FAILURE;
+ }
+ }
+
/* Assign default initializer. */
if (!(sym->value || sym->attr.pointer || sym->attr.allocatable)
&& (!no_init_flag || sym->attr.intent == INTENT_OUT))
if (sym->attr.allocatable || sym->attr.external || sym->attr.dummy
|| sym->attr.intrinsic || sym->attr.result)
no_init_flag = 1;
- else if ((sym->attr.dimension || sym->attr.codimension) && !sym->attr.pointer
+ else if (sym->attr.dimension && !sym->attr.pointer
&& is_non_constant_shape_array (sym))
{
no_init_flag = automatic_flag = 1;
{
gfc_symtree* overriding;
overriding = gfc_find_typebound_proc (sub, NULL, st->name, true, NULL);
- if (!overriding)
- return FAILURE;
- gcc_assert (overriding->n.tb);
+ gcc_assert (overriding && overriding->n.tb);
if (overriding->n.tb->deferred)
{
gfc_error ("Derived-type '%s' declared at %L must be ABSTRACT because"
This is not the most efficient way to do this, but it should be ok and is
clearer than something sophisticated. */
- gcc_assert (ancestor && !sub->attr.abstract);
-
- if (!ancestor->attr.abstract)
- return SUCCESS;
+ gcc_assert (ancestor && ancestor->attr.abstract && !sub->attr.abstract);
/* Walk bindings of this ancestor. */
if (ancestor->f2k_derived)
int i;
super_type = gfc_get_derived_super_type (sym);
-
- if (sym->attr.is_class && sym->ts.u.derived == NULL)
- {
- /* Fix up incomplete CLASS symbols. */
- gfc_component *data;
- gfc_component *vptr;
- gfc_symbol *vtab;
- data = gfc_find_component (sym, "$data", true, true);
- vptr = gfc_find_component (sym, "$vptr", true, true);
- if (vptr->ts.u.derived == NULL)
- {
- vtab = gfc_find_derived_vtab (data->ts.u.derived, false);
- gcc_assert (vtab);
- vptr->ts.u.derived = vtab->ts.u.derived;
- }
- }
-
- /* F2008, C432. */
- if (super_type && sym->attr.coarray_comp && !super_type->attr.coarray_comp)
- {
- gfc_error ("As extending type '%s' at %L has a coarray component, "
- "parent type '%s' shall also have one", sym->name,
- &sym->declared_at, super_type->name);
- return FAILURE;
- }
/* Ensure the extended type gets resolved before we do. */
if (super_type && resolve_fl_derived (super_type) == FAILURE)
for (c = sym->components; c != NULL; c = c->next)
{
- /* F2008, C442. */
- if (c->attr.codimension /* FIXME: c->as check due to PR 43412. */
- && (!c->attr.allocatable || (c->as && c->as->type != AS_DEFERRED)))
- {
- gfc_error ("Coarray component '%s' at %L must be allocatable with "
- "deferred shape", c->name, &c->loc);
- return FAILURE;
- }
-
- /* F2008, C443. */
- if (c->attr.codimension && c->ts.type == BT_DERIVED
- && c->ts.u.derived->ts.is_iso_c)
- {
- gfc_error ("Component '%s' at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
- "shall not be a coarray", c->name, &c->loc);
- return FAILURE;
- }
-
- /* F2008, C444. */
- if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp
- && (c->attr.codimension || c->attr.pointer || c->attr.dimension
- || c->attr.allocatable))
- {
- gfc_error ("Component '%s' at %L with coarray component "
- "shall be a nonpointer, nonallocatable scalar",
- c->name, &c->loc);
- return FAILURE;
- }
-
if (c->attr.proc_pointer && c->ts.interface)
{
- if (c->ts.interface->attr.procedure && !sym->attr.vtype)
+ if (c->ts.interface->attr.procedure)
gfc_error ("Interface '%s', used by procedure pointer component "
"'%s' at %L, is declared in a later PROCEDURE statement",
c->ts.interface->name, c->name, &c->loc);
/* Copy char length. */
if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl)
{
- gfc_charlen *cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl);
- gfc_expr_replace_comp (cl->length, c);
- if (cl->length && !cl->resolved
- && gfc_resolve_expr (cl->length) == FAILURE)
- return FAILURE;
- c->ts.u.cl = cl;
+ c->ts.u.cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl);
+ gfc_expr_replace_comp (c->ts.u.cl->length, c);
}
}
- else if (c->ts.interface->name[0] != '\0' && !sym->attr.vtype)
+ else if (c->ts.interface->name[0] != '\0')
{
gfc_error ("Interface '%s' of procedure pointer component "
"'%s' at %L must be explicit", c->ts.interface->name,
}
/* Procedure pointer components: Check PASS arg. */
- if (c->attr.proc_pointer && !c->tb->nopass && c->tb->pass_arg_num == 0
- && !sym->attr.vtype)
+ if (c->attr.proc_pointer && !c->tb->nopass && c->tb->pass_arg_num == 0)
{
gfc_symbol* me_arg;
/* If this type is an extension, see if this component has the same name
as an inherited type-bound procedure. */
- if (super_type && !sym->attr.is_class
+ if (super_type
&& gfc_find_typebound_proc (super_type, NULL, c->name, true, NULL))
{
gfc_error ("Component '%s' of '%s' at %L has the same name as an"
}
}
- if (!sym->attr.is_class && c->ts.type == BT_DERIVED && c->attr.pointer
+ if (c->ts.type == BT_DERIVED && c->attr.pointer
&& c->ts.u.derived->components == NULL
&& !c->ts.u.derived->attr.zero_comp)
{
return FAILURE;
}
- if (c->ts.type == BT_CLASS && c->ts.u.derived->components->attr.pointer
- && c->ts.u.derived->components->ts.u.derived->components == NULL
- && !c->ts.u.derived->components->ts.u.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,
- &c->loc);
- return FAILURE;
- }
-
/* C437. */
if (c->ts.type == BT_CLASS
&& !(c->ts.u.derived->components->attr.pointer
gfc_namespace *ns;
gfc_component *c;
- /* Avoid double resolution of function result symbols. */
- if ((sym->result || sym->attr.result) && (sym->ns != gfc_current_ns))
- return;
-
if (sym->attr.flavor == FL_UNKNOWN)
{
{
sym->ts.u.cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl);
gfc_expr_replace_symbols (sym->ts.u.cl->length, sym);
- if (sym->ts.u.cl->length && !sym->ts.u.cl->resolved
- && gfc_resolve_expr (sym->ts.u.cl->length) == FAILURE)
- return;
}
}
else if (sym->ts.interface->name[0] != '\0')
arguments. */
if (sym->as != NULL
- && ((sym->as->type == AS_ASSUMED_SIZE && !sym->as->cp_was_assumed)
+ && (sym->as->type == AS_ASSUMED_SIZE
|| sym->as->type == AS_ASSUMED_SHAPE)
&& sym->attr.dummy == 0)
{
}
}
- /* F2008, C526. */
- if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
- || sym->attr.codimension)
- && sym->attr.result)
- gfc_error ("Function result '%s' at %L shall not be a coarray or have "
- "a coarray component", sym->name, &sym->declared_at);
-
- /* F2008, C524. */
- if (sym->attr.codimension && sym->ts.type == BT_DERIVED
- && sym->ts.u.derived->ts.is_iso_c)
- gfc_error ("Variable '%s' at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
- "shall not be a coarray", sym->name, &sym->declared_at);
-
- /* F2008, C525. */
- if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp
- && (sym->attr.codimension || sym->attr.pointer || sym->attr.dimension
- || sym->attr.allocatable))
- gfc_error ("Variable '%s' at %L with coarray component "
- "shall be a nonpointer, nonallocatable scalar",
- sym->name, &sym->declared_at);
-
- /* F2008, C526. The function-result case was handled above. */
- if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
- || sym->attr.codimension)
- && !(sym->attr.allocatable || sym->attr.dummy || sym->attr.save
- || sym->ns->proc_name->attr.flavor == FL_MODULE
- || sym->ns->proc_name->attr.is_main_program
- || sym->attr.function || sym->attr.result || sym->attr.use_assoc))
- gfc_error ("Variable '%s' at %L is a coarray or has a coarray "
- "component and is not ALLOCATABLE, SAVE nor a "
- "dummy argument", sym->name, &sym->declared_at);
- /* F2008, C528. */ /* FIXME: sym->as check due to PR 43412. */
- else if (sym->attr.codimension && !sym->attr.allocatable
- && sym->as && sym->as->cotype == AS_DEFERRED)
- gfc_error ("Coarray variable '%s' at %L shall not have codimensions with "
- "deferred shape", sym->name, &sym->declared_at);
- else if (sym->attr.codimension && sym->attr.allocatable
- && (sym->as->type != AS_DEFERRED || sym->as->cotype != AS_DEFERRED))
- gfc_error ("Allocatable coarray variable '%s' at %L must have "
- "deferred shape", sym->name, &sym->declared_at);
-
-
- /* F2008, C541. */
- if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
- || (sym->attr.codimension && sym->attr.allocatable))
- && sym->attr.dummy && sym->attr.intent == INTENT_OUT)
- gfc_error ("Variable '%s' at %L is INTENT(OUT) and can thus not be an "
- "allocatable coarray or have coarray components",
- sym->name, &sym->declared_at);
-
- if (sym->attr.codimension && sym->attr.dummy
- && sym->ns->proc_name && sym->ns->proc_name->attr.is_bind_c)
- gfc_error ("Coarray dummy variable '%s' at %L not allowed in BIND(C) "
- "procedure '%s'", sym->name, &sym->declared_at,
- sym->ns->proc_name->name);
-
switch (sym->attr.flavor)
{
case FL_VARIABLE:
if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
has_pointer = 1;
- if (ref->type == REF_ARRAY && ref->u.ar.codimen)
- {
- gfc_error ("DATA element '%s' at %L cannot have a coindex",
- sym->name, where);
- return FAILURE;
- }
-
if (has_pointer
&& ref->type == REF_ARRAY
&& ref->u.ar.type != AR_FULL)
mpz_set_ui (size, 0);
}
- t = gfc_assign_data_value_range (var->expr, values.vnode->expr,
- offset, range);
+ gfc_assign_data_value_range (var->expr, values.vnode->expr,
+ offset, range);
mpz_add (offset, offset, range);
mpz_clear (range);
-
- if (t == FAILURE)
- break;
}
/* Assign initial value to symbol. */
gfc_try retval = SUCCESS;
mpz_init (frame.value);
- mpz_init (trip);
start = gfc_copy_expr (var->iter.start);
end = gfc_copy_expr (var->iter.end);
if (gfc_simplify_expr (start, 1) == FAILURE
|| start->expr_type != EXPR_CONSTANT)
{
- gfc_error ("start of implied-do loop at %L could not be "
- "simplified to a constant value", &start->where);
+ gfc_error ("iterator start at %L does not simplify", &start->where);
retval = FAILURE;
goto cleanup;
}
if (gfc_simplify_expr (end, 1) == FAILURE
|| end->expr_type != EXPR_CONSTANT)
{
- gfc_error ("end of implied-do loop at %L could not be "
- "simplified to a constant value", &start->where);
+ gfc_error ("iterator end at %L does not simplify", &end->where);
retval = FAILURE;
goto cleanup;
}
if (gfc_simplify_expr (step, 1) == FAILURE
|| step->expr_type != EXPR_CONSTANT)
{
- gfc_error ("step of implied-do loop at %L could not be "
- "simplified to a constant value", &start->where);
+ gfc_error ("iterator step at %L does not simplify", &step->where);
retval = FAILURE;
goto cleanup;
}
- mpz_set (trip, end->value.integer);
+ mpz_init_set (trip, end->value.integer);
mpz_sub (trip, trip, start->value.integer);
mpz_add (trip, trip, step->value.integer);
{
if (traverse_data_var (var->list, where) == FAILURE)
{
+ mpz_clear (trip);
retval = FAILURE;
goto cleanup;
}
if (gfc_simplify_expr (e, 1) == FAILURE)
{
gfc_free_expr (e);
+ mpz_clear (trip);
retval = FAILURE;
goto cleanup;
}
mpz_sub_ui (trip, trip, 1);
}
+ mpz_clear (trip);
cleanup:
mpz_clear (frame.value);
- mpz_clear (trip);
gfc_free_expr (start);
gfc_free_expr (end);
return FAILURE;
}
- if (sym->attr.in_common && gfc_has_default_initializer (sym->ts.u.derived))
+ if (sym->attr.in_common && has_default_initializer (sym->ts.u.derived))
{
gfc_error ("Derived type variable '%s' at %L with default "
"initialization cannot be in EQUIVALENCE with a variable "
{
ref->type = REF_SUBSTRING;
if (start == NULL)
- start = gfc_get_int_expr (gfc_default_integer_kind,
- NULL, 1);
+ start = gfc_int_expr (1);
ref->u.ss.start = start;
if (end == NULL && e->ts.u.cl)
end = gfc_copy_expr (e->ts.u.cl->length);
OSDN Git Service
