OSDN Git Service

2010-04-12 Jerry DeLisle <jvdelisle@gcc.gnu.org>
authorjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 13 Apr 2010 01:59:35 +0000 (01:59 +0000)
committerMasaki Muranaka <monaka@monami-software.com>
Sun, 23 May 2010 00:58:48 +0000 (09:58 +0900)
* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158253 138bc75d-0d04-0410-961f-82ee72b054a4

17 files changed:
gcc/fortran/ChangeLog
gcc/fortran/Make-lang.in
gcc/fortran/array.c
gcc/fortran/constructor.c
gcc/fortran/data.c
gcc/fortran/decl.c
gcc/fortran/expr.c
gcc/fortran/gfortran.h
gcc/fortran/match.c
gcc/fortran/module.c
gcc/fortran/resolve.c
gcc/fortran/simplify.c
gcc/fortran/symbol.c
gcc/fortran/trans-array.c
gcc/fortran/trans-decl.c
gcc/fortran/trans-expr.c
gcc/fortran/trans.h

index 17933ff..4ef8eb9 100644 (file)
@@ -1,3 +1,319 @@
+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
index b74f9e9..d9544a4 100644 (file)
@@ -53,13 +53,13 @@ fortran-warn = $(STRICT_WARN)
 # from the parse tree to GENERIC
 
 F95_PARSER_OBJS = fortran/arith.o fortran/array.o fortran/bbt.o \
-    fortran/check.o fortran/class.o fortran/constructor.o fortran/cpp.o \
-    fortran/data.o fortran/decl.o fortran/dump-parse-tree.o fortran/error.o \
-    fortran/expr.o fortran/interface.o fortran/intrinsic.o fortran/io.o \
-    fortran/iresolve.o fortran/match.o fortran/matchexp.o fortran/misc.o \
-    fortran/module.o fortran/openmp.o fortran/options.o fortran/parse.o \
-    fortran/primary.o fortran/resolve.o fortran/scanner.o fortran/simplify.o \
-    fortran/st.o fortran/symbol.o fortran/target-memory.o
+    fortran/check.o fortran/constructor.o fortran/cpp.o fortran/data.o \
+    fortran/decl.o fortran/dump-parse-tree.o fortran/error.o fortran/expr.o \
+    fortran/interface.o fortran/intrinsic.o fortran/io.o fortran/iresolve.o \
+    fortran/match.o fortran/matchexp.o fortran/misc.o fortran/module.o \
+    fortran/openmp.o fortran/options.o fortran/parse.o fortran/primary.o \
+    fortran/resolve.o fortran/scanner.o fortran/simplify.o fortran/st.o \
+    fortran/symbol.o fortran/target-memory.o
 
 F95_OBJS = $(F95_PARSER_OBJS) $(FORTRAN_TARGET_OBJS) \
     fortran/convert.o fortran/dependency.o fortran/f95-lang.o \
@@ -345,7 +345,7 @@ fortran/trans-decl.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-decl.h \
   $(TREE_DUMP_H) debug.h pointer-set.h
 fortran/trans-types.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-types.h \
   $(REAL_H) toplev.h $(TARGET_H) $(FLAGS_H) dwarf2out.h
-fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS) realmpfr.h
+fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS)
 fortran/trans-expr.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
 fortran/trans-stmt.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
 fortran/trans-openmp.o: $(GFORTRAN_TRANS_DEPS)
index 5ceca4b..c3e366d 100644 (file)
@@ -23,6 +23,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "system.h"
 #include "gfortran.h"
 #include "match.h"
+#include "constructor.h"
 
 /**************** Array reference matching subroutines *****************/
 
@@ -365,7 +366,7 @@ match_array_element_spec (gfc_array_spec *as)
 
   if (gfc_match_char ('*') == MATCH_YES)
     {
-      *lower = gfc_int_expr (1);
+      *lower = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
       return AS_ASSUMED_SIZE;
     }
 
@@ -382,7 +383,7 @@ match_array_element_spec (gfc_array_spec *as)
 
   if (gfc_match_char (':') == MATCH_NO)
     {
-      *lower = gfc_int_expr (1);
+      *lower = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
       return AS_EXPLICIT;
     }
 
@@ -635,7 +636,7 @@ done:
       for (i = 0; i < as->rank + as->corank; i++)
        {
          if (as->lower[i] == NULL)
-           as->lower[i] = gfc_int_expr (1);
+           as->lower[i] = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
        }
     }
 
@@ -806,151 +807,6 @@ gfc_compare_array_spec (gfc_array_spec *as1, gfc_array_spec *as2)
 
 /****************** Array constructor functions ******************/
 
-/* Start an array constructor.  The constructor starts with zero
-   elements and should be appended to by gfc_append_constructor().  */
-
-gfc_expr *
-gfc_start_constructor (bt type, int kind, locus *where)
-{
-  gfc_expr *result;
-
-  result = gfc_get_expr ();
-
-  result->expr_type = EXPR_ARRAY;
-  result->rank = 1;
-
-  result->ts.type = type;
-  result->ts.kind = kind;
-  result->where = *where;
-  return result;
-}
-
-
-/* Given an array constructor expression, append the new expression
-   node onto the constructor.  */
-
-void
-gfc_append_constructor (gfc_expr *base, gfc_expr *new_expr)
-{
-  gfc_constructor *c;
-
-  if (base->value.constructor == NULL)
-    base->value.constructor = c = gfc_get_constructor ();
-  else
-    {
-      c = base->value.constructor;
-      while (c->next)
-       c = c->next;
-
-      c->next = gfc_get_constructor ();
-      c = c->next;
-    }
-
-  c->expr = new_expr;
-
-  if (new_expr
-      && (new_expr->ts.type != base->ts.type || new_expr->ts.kind != base->ts.kind))
-    gfc_internal_error ("gfc_append_constructor(): New node has wrong kind");
-}
-
-
-/* Given an array constructor expression, insert the new expression's
-   constructor onto the base's one according to the offset.  */
-
-void
-gfc_insert_constructor (gfc_expr *base, gfc_constructor *c1)
-{
-  gfc_constructor *c, *pre;
-  expr_t type;
-  int t;
-
-  type = base->expr_type;
-
-  if (base->value.constructor == NULL)
-    base->value.constructor = c1;
-  else
-    {
-      c = pre = base->value.constructor;
-      while (c)
-       {
-         if (type == EXPR_ARRAY)
-           {
-             t = mpz_cmp (c->n.offset, c1->n.offset);
-             if (t < 0)
-               {
-                 pre = c;
-                 c = c->next;
-               }
-             else if (t == 0)
-               {
-                 gfc_error ("duplicated initializer");
-                 break;
-               }
-             else
-               break;
-           }
-         else
-           {
-             pre = c;
-             c = c->next;
-           }
-       }
-
-      if (pre != c)
-       {
-         pre->next = c1;
-         c1->next = c;
-       }
-      else
-       {
-         c1->next = c;
-         base->value.constructor = c1;
-       }
-    }
-}
-
-
-/* Get a new constructor.  */
-
-gfc_constructor *
-gfc_get_constructor (void)
-{
-  gfc_constructor *c;
-
-  c = XCNEW (gfc_constructor);
-  c->expr = NULL;
-  c->iterator = NULL;
-  c->next = NULL;
-  mpz_init_set_si (c->n.offset, 0);
-  mpz_init_set_si (c->repeat, 0);
-  return c;
-}
-
-
-/* Free chains of gfc_constructor structures.  */
-
-void
-gfc_free_constructor (gfc_constructor *p)
-{
-  gfc_constructor *next;
-
-  if (p == NULL)
-    return;
-
-  for (; p; p = next)
-    {
-      next = p->next;
-
-      if (p->expr)
-       gfc_free_expr (p->expr);
-      if (p->iterator != NULL)
-       gfc_free_iterator (p->iterator, 1);
-      mpz_clear (p->n.offset);
-      mpz_clear (p->repeat);
-      gfc_free (p);
-    }
-}
-
 
 /* Given an expression node that might be an array constructor and a
    symbol, make sure that no iterators in this or child constructors
@@ -958,11 +814,12 @@ gfc_free_constructor (gfc_constructor *p)
    duplicate was found.  */
 
 static int
-check_duplicate_iterator (gfc_constructor *c, gfc_symbol *master)
+check_duplicate_iterator (gfc_constructor_base base, gfc_symbol *master)
 {
+  gfc_constructor *c;
   gfc_expr *e;
 
-  for (; c; c = c->next)
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
     {
       e = c->expr;
 
@@ -987,14 +844,15 @@ check_duplicate_iterator (gfc_constructor *c, gfc_symbol *master)
 
 
 /* Forward declaration because these functions are mutually recursive.  */
-static match match_array_cons_element (gfc_constructor **);
+static match match_array_cons_element (gfc_constructor_base *);
 
 /* Match a list of array elements.  */
 
 static match
-match_array_list (gfc_constructor **result)
+match_array_list (gfc_constructor_base *result)
 {
-  gfc_constructor *p, *head, *tail, *new_cons;
+  gfc_constructor_base head;
+  gfc_constructor *p;
   gfc_iterator iter;
   locus old_loc;
   gfc_expr *e;
@@ -1013,8 +871,6 @@ match_array_list (gfc_constructor **result)
   if (m != MATCH_YES)
     goto cleanup;
 
-  tail = head;
-
   if (gfc_match_char (',') != MATCH_YES)
     {
       m = MATCH_NO;
@@ -1029,7 +885,7 @@ match_array_list (gfc_constructor **result)
       if (m == MATCH_ERROR)
        goto cleanup;
 
-      m = match_array_cons_element (&new_cons);
+      m = match_array_cons_element (&head);
       if (m == MATCH_ERROR)
        goto cleanup;
       if (m == MATCH_NO)
@@ -1040,9 +896,6 @@ match_array_list (gfc_constructor **result)
          goto cleanup;         /* Could be a complex constant */
        }
 
-      tail->next = new_cons;
-      tail = new_cons;
-
       if (gfc_match_char (',') != MATCH_YES)
        {
          if (n > 2)
@@ -1061,19 +914,13 @@ match_array_list (gfc_constructor **result)
       goto cleanup;
     }
 
-  e = gfc_get_expr ();
-  e->expr_type = EXPR_ARRAY;
-  e->where = old_loc;
+  e = gfc_get_array_expr (BT_UNKNOWN, 0, &old_loc);
   e->value.constructor = head;
 
-  p = gfc_get_constructor ();
-  p->where = gfc_current_locus;
+  p = gfc_constructor_append_expr (result, e, &gfc_current_locus);
   p->iterator = gfc_get_iterator ();
   *p->iterator = iter;
 
-  p->expr = e;
-  *result = p;
-
   return MATCH_YES;
 
 syntax:
@@ -1081,7 +928,7 @@ syntax:
   m = MATCH_ERROR;
 
 cleanup:
-  gfc_free_constructor (head);
+  gfc_constructor_free (head);
   gfc_free_iterator (&iter, 0);
   gfc_current_locus = old_loc;
   return m;
@@ -1092,9 +939,8 @@ cleanup:
    single expression or a list of elements.  */
 
 static match
-match_array_cons_element (gfc_constructor **result)
+match_array_cons_element (gfc_constructor_base *result)
 {
-  gfc_constructor *p;
   gfc_expr *expr;
   match m;
 
@@ -1106,11 +952,7 @@ match_array_cons_element (gfc_constructor **result)
   if (m != MATCH_YES)
     return m;
 
-  p = gfc_get_constructor ();
-  p->where = gfc_current_locus;
-  p->expr = expr;
-
-  *result = p;
+  gfc_constructor_append_expr (result, expr, &gfc_current_locus);
   return MATCH_YES;
 }
 
@@ -1120,7 +962,7 @@ match_array_cons_element (gfc_constructor **result)
 match
 gfc_match_array_constructor (gfc_expr **result)
 {
-  gfc_constructor *head, *tail, *new_cons;
+  gfc_constructor_base head, new_cons;
   gfc_expr *expr;
   gfc_typespec ts;
   locus where;
@@ -1144,7 +986,7 @@ gfc_match_array_constructor (gfc_expr **result)
     end_delim = " /)";
 
   where = gfc_current_locus;
-  head = tail = NULL;
+  head = new_cons = NULL;
   seen_ts = false;
 
   /* Try to match an optional "type-spec ::"  */
@@ -1176,19 +1018,12 @@ gfc_match_array_constructor (gfc_expr **result)
 
   for (;;)
     {
-      m = match_array_cons_element (&new_cons);
+      m = match_array_cons_element (&head);
       if (m == MATCH_ERROR)
        goto cleanup;
       if (m == MATCH_NO)
        goto syntax;
 
-      if (head == NULL)
-       head = new_cons;
-      else
-       tail->next = new_cons;
-
-      tail = new_cons;
-
       if (gfc_match_char (',') == MATCH_NO)
        break;
     }
@@ -1197,24 +1032,19 @@ gfc_match_array_constructor (gfc_expr **result)
     goto syntax;
 
 done:
-  expr = gfc_get_expr ();
-
-  expr->expr_type = EXPR_ARRAY;
-
-  expr->value.constructor = head;
   /* Size must be calculated at resolution time.  */
-
   if (seen_ts)
-    expr->ts = ts;
+    {
+      expr = gfc_get_array_expr (ts.type, ts.kind, &where);
+      expr->ts = ts;
+    }
   else
-    expr->ts.type = BT_UNKNOWN;
-  
+    expr = gfc_get_array_expr (BT_UNKNOWN, 0, &where);
+
+  expr->value.constructor = head;
   if (expr->ts.u.cl)
     expr->ts.u.cl->length_from_typespec = seen_ts;
 
-  expr->where = where;
-  expr->rank = 1;
-
   *result = expr;
   return MATCH_YES;
 
@@ -1222,7 +1052,7 @@ syntax:
   gfc_error ("Syntax error in array constructor at %C");
 
 cleanup:
-  gfc_free_constructor (head);
+  gfc_constructor_free (head);
   return MATCH_ERROR;
 }
 
@@ -1278,11 +1108,12 @@ check_element_type (gfc_expr *expr, bool convert)
 /* Recursive work function for gfc_check_constructor_type().  */
 
 static gfc_try
-check_constructor_type (gfc_constructor *c, bool convert)
+check_constructor_type (gfc_constructor_base base, bool convert)
 {
+  gfc_constructor *c;
   gfc_expr *e;
 
-  for (; c; c = c->next)
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
     {
       e = c->expr;
 
@@ -1341,7 +1172,7 @@ cons_stack;
 
 static cons_stack *base;
 
-static gfc_try check_constructor (gfc_constructor *, gfc_try (*) (gfc_expr *));
+static gfc_try check_constructor (gfc_constructor_base, gfc_try (*) (gfc_expr *));
 
 /* Check an EXPR_VARIABLE expression in a constructor to make sure
    that that variable is an iteration variables.  */
@@ -1367,13 +1198,14 @@ gfc_check_iter_variable (gfc_expr *expr)
    constructor, giving variables with the names of iterators a pass.  */
 
 static gfc_try
-check_constructor (gfc_constructor *c, gfc_try (*check_function) (gfc_expr *))
+check_constructor (gfc_constructor_base ctor, gfc_try (*check_function) (gfc_expr *))
 {
   cons_stack element;
   gfc_expr *e;
   gfc_try t;
+  gfc_constructor *c;
 
-  for (; c; c = c->next)
+  for (c = gfc_constructor_first (ctor); c; c = gfc_constructor_next (c))
     {
       e = c->expr;
 
@@ -1427,7 +1259,7 @@ iterator_stack *iter_stack;
 
 typedef struct
 {
-  gfc_constructor *new_head, *new_tail;
+  gfc_constructor_base base;
   int extract_count, extract_n;
   gfc_expr *extracted;
   mpz_t *count;
@@ -1442,7 +1274,7 @@ expand_info;
 
 static expand_info current_expand;
 
-static gfc_try expand_constructor (gfc_constructor *);
+static gfc_try expand_constructor (gfc_constructor_base);
 
 
 /* Work function that counts the number of elements present in a
@@ -1501,21 +1333,10 @@ extract_element (gfc_expr *e)
 static gfc_try
 expand (gfc_expr *e)
 {
-  if (current_expand.new_head == NULL)
-    current_expand.new_head = current_expand.new_tail =
-      gfc_get_constructor ();
-  else
-    {
-      current_expand.new_tail->next = gfc_get_constructor ();
-      current_expand.new_tail = current_expand.new_tail->next;
-    }
+  gfc_constructor *c = gfc_constructor_append_expr (&current_expand.base,
+                                                   e, &e->where);
 
-  current_expand.new_tail->where = e->where;
-  current_expand.new_tail->expr = e;
-
-  mpz_set (current_expand.new_tail->n.offset, *current_expand.offset);
-  current_expand.new_tail->n.component = current_expand.component;
-  mpz_set (current_expand.new_tail->repeat, *current_expand.repeat);
+  c->n.component = current_expand.component;
   return SUCCESS;
 }
 
@@ -1535,7 +1356,7 @@ gfc_simplify_iterator_var (gfc_expr *e)
   if (p == NULL)
     return;            /* Variable not found */
 
-  gfc_replace_expr (e, gfc_int_expr (0));
+  gfc_replace_expr (e, gfc_get_int_expr (gfc_default_integer_kind, NULL, 0));
 
   mpz_set (e->value.integer, p->value);
 
@@ -1649,11 +1470,12 @@ cleanup:
    passed expression.  */
 
 static gfc_try
-expand_constructor (gfc_constructor *c)
+expand_constructor (gfc_constructor_base base)
 {
+  gfc_constructor *c;
   gfc_expr *e;
 
-  for (; c; c = c->next)
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next(c))
     {
       if (c->iterator != NULL)
        {
@@ -1678,9 +1500,9 @@ expand_constructor (gfc_constructor *c)
          gfc_free_expr (e);
          return FAILURE;
        }
-      current_expand.offset = &c->n.offset;
-      current_expand.component = c->n.component;
+      current_expand.offset = &c->offset;
       current_expand.repeat = &c->repeat;
+      current_expand.component = c->n.component;
       if (current_expand.expand_work_function (e) == FAILURE)
        return FAILURE;
     }
@@ -1688,6 +1510,39 @@ expand_constructor (gfc_constructor *c)
 }
 
 
+/* Given an array expression and an element number (starting at zero),
+   return a pointer to the array element.  NULL is returned if the
+   size of the array has been exceeded.  The expression node returned
+   remains a part of the array and should not be freed.  Access is not
+   efficient at all, but this is another place where things do not
+   have to be particularly fast.  */
+
+static gfc_expr *
+gfc_get_array_element (gfc_expr *array, int element)
+{
+  expand_info expand_save;
+  gfc_expr *e;
+  gfc_try rc;
+
+  expand_save = current_expand;
+  current_expand.extract_n = element;
+  current_expand.expand_work_function = extract_element;
+  current_expand.extracted = NULL;
+  current_expand.extract_count = 0;
+
+  iter_stack = NULL;
+
+  rc = expand_constructor (array->value.constructor);
+  e = current_expand.extracted;
+  current_expand = expand_save;
+
+  if (rc == FAILURE)
+    return NULL;
+
+  return e;
+}
+
+
 /* Top level subroutine for expanding constructors.  We only expand
    constructor if they are small enough.  */
 
@@ -1698,6 +1553,8 @@ gfc_expand_constructor (gfc_expr *e)
   gfc_expr *f;
   gfc_try rc;
 
+  /* If we can successfully get an array element at the max array size then
+     the array is too big to expand, so we just return.  */
   f = gfc_get_array_element (e, gfc_option.flag_max_array_constructor);
   if (f != NULL)
     {
@@ -1705,8 +1562,9 @@ gfc_expand_constructor (gfc_expr *e)
       return SUCCESS;
     }
 
+  /* We now know the array is not too big so go ahead and try to expand it.  */
   expand_save = current_expand;
-  current_expand.new_head = current_expand.new_tail = NULL;
+  current_expand.base = NULL;
 
   iter_stack = NULL;
 
@@ -1714,13 +1572,13 @@ gfc_expand_constructor (gfc_expr *e)
 
   if (expand_constructor (e->value.constructor) == FAILURE)
     {
-      gfc_free_constructor (current_expand.new_head);
+      gfc_constructor_free (current_expand.base);
       rc = FAILURE;
       goto done;
     }
 
-  gfc_free_constructor (e->value.constructor);
-  e->value.constructor = current_expand.new_head;
+  gfc_constructor_free (e->value.constructor);
+  e->value.constructor = current_expand.base;
 
   rc = SUCCESS;
 
@@ -1758,37 +1616,14 @@ gfc_constant_ac (gfc_expr *e)
 {
   expand_info expand_save;
   gfc_try rc;
-  gfc_constructor * con;
-  
-  rc = SUCCESS;
 
-  if (e->value.constructor
-      && e->value.constructor->expr->expr_type == EXPR_ARRAY)
-    {
-      /* Expand the constructor.  */
-      iter_stack = NULL;
-      expand_save = current_expand;
-      current_expand.expand_work_function = is_constant_element;
+  iter_stack = NULL;
+  expand_save = current_expand;
+  current_expand.expand_work_function = is_constant_element;
 
-      rc = expand_constructor (e->value.constructor);
-
-      current_expand = expand_save;
-    }
-  else
-    {
-      /* No need to expand this further.  */
-      for (con = e->value.constructor; con; con = con->next)
-       {
-         if (con->expr->expr_type == EXPR_CONSTANT)
-           continue;
-         else
-           {
-             if (!gfc_is_constant_expr (con->expr))
-               rc = FAILURE;
-           }
-       }
-    }
+  rc = expand_constructor (e->value.constructor);
 
+  current_expand = expand_save;
   if (rc == FAILURE)
     return 0;
 
@@ -1802,11 +1637,12 @@ gfc_constant_ac (gfc_expr *e)
 int
 gfc_expanded_ac (gfc_expr *e)
 {
-  gfc_constructor *p;
+  gfc_constructor *c;
 
   if (e->expr_type == EXPR_ARRAY)
-    for (p = e->value.constructor; p; p = p->next)
-      if (p->iterator != NULL || !gfc_expanded_ac (p->expr))
+    for (c = gfc_constructor_first (e->value.constructor);
+        c; c = gfc_constructor_next (c))
+      if (c->iterator != NULL || !gfc_expanded_ac (c->expr))
        return 0;
 
   return 1;
@@ -1819,19 +1655,20 @@ gfc_expanded_ac (gfc_expr *e)
    be of the same type.  */
 
 static gfc_try
-resolve_array_list (gfc_constructor *p)
+resolve_array_list (gfc_constructor_base base)
 {
   gfc_try t;
+  gfc_constructor *c;
 
   t = SUCCESS;
 
-  for (; p; p = p->next)
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
     {
-      if (p->iterator != NULL
-         && gfc_resolve_iterator (p->iterator, false) == FAILURE)
+      if (c->iterator != NULL
+         && gfc_resolve_iterator (c->iterator, false) == FAILURE)
        t = FAILURE;
 
-      if (gfc_resolve_expr (p->expr) == FAILURE)
+      if (gfc_resolve_expr (c->expr) == FAILURE)
        t = FAILURE;
     }
 
@@ -1854,7 +1691,8 @@ gfc_resolve_character_array_constructor (gfc_expr *expr)
 
   if (expr->ts.u.cl == NULL)
     {
-      for (p = expr->value.constructor; p; p = p->next)
+      for (p = gfc_constructor_first (expr->value.constructor);
+          p; p = gfc_constructor_next (p))
        if (p->expr->ts.u.cl != NULL)
          {
            /* Ensure that if there is a char_len around that it is
@@ -1875,7 +1713,8 @@ got_charlen:
       /* Check that all constant string elements have the same length until
         we reach the end or find a variable-length one.  */
 
-      for (p = expr->value.constructor; p; p = p->next)
+      for (p = gfc_constructor_first (expr->value.constructor);
+          p; p = gfc_constructor_next (p))
        {
          int current_length = -1;
          gfc_ref *ref;
@@ -1922,7 +1761,8 @@ got_charlen:
       gcc_assert (found_length != -1);
 
       /* Update the character length of the array constructor.  */
-      expr->ts.u.cl->length = gfc_int_expr (found_length);
+      expr->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+                                               NULL, found_length);
     }
   else 
     {
@@ -1940,7 +1780,8 @@ got_charlen:
         (without typespec) all elements are verified to have the same length
         anyway.  */
       if (found_length != -1)
-       for (p = expr->value.constructor; p; p = p->next)
+       for (p = gfc_constructor_first (expr->value.constructor);
+            p; p = gfc_constructor_next (p))
          if (p->expr->expr_type == EXPR_CONSTANT)
            {
              gfc_expr *cl = NULL;
@@ -1990,8 +1831,8 @@ gfc_resolve_array_constructor (gfc_expr *expr)
 
 /* Copy an iterator structure.  */
 
-static gfc_iterator *
-copy_iterator (gfc_iterator *src)
+gfc_iterator *
+gfc_copy_iterator (gfc_iterator *src)
 {
   gfc_iterator *dest;
 
@@ -2009,73 +1850,6 @@ copy_iterator (gfc_iterator *src)
 }
 
 
-/* Copy a constructor structure.  */
-
-gfc_constructor *
-gfc_copy_constructor (gfc_constructor *src)
-{
-  gfc_constructor *dest;
-  gfc_constructor *tail;
-
-  if (src == NULL)
-    return NULL;
-
-  dest = tail = NULL;
-  while (src)
-    {
-      if (dest == NULL)
-       dest = tail = gfc_get_constructor ();
-      else
-       {
-         tail->next = gfc_get_constructor ();
-         tail = tail->next;
-       }
-      tail->where = src->where;
-      tail->expr = gfc_copy_expr (src->expr);
-      tail->iterator = copy_iterator (src->iterator);
-      mpz_set (tail->n.offset, src->n.offset);
-      tail->n.component = src->n.component;
-      mpz_set (tail->repeat, src->repeat);
-      src = src->next;
-    }
-
-  return dest;
-}
-
-
-/* Given an array expression and an element number (starting at zero),
-   return a pointer to the array element.  NULL is returned if the
-   size of the array has been exceeded.  The expression node returned
-   remains a part of the array and should not be freed.  Access is not
-   efficient at all, but this is another place where things do not
-   have to be particularly fast.  */
-
-gfc_expr *
-gfc_get_array_element (gfc_expr *array, int element)
-{
-  expand_info expand_save;
-  gfc_expr *e;
-  gfc_try rc;
-
-  expand_save = current_expand;
-  current_expand.extract_n = element;
-  current_expand.expand_work_function = extract_element;
-  current_expand.extracted = NULL;
-  current_expand.extract_count = 0;
-
-  iter_stack = NULL;
-
-  rc = expand_constructor (array->value.constructor);
-  e = current_expand.extracted;
-  current_expand = expand_save;
-
-  if (rc == FAILURE)
-    return NULL;
-
-  return e;
-}
-
-
 /********* Subroutines for determining the size of an array *********/
 
 /* These are needed just to accommodate RESHAPE().  There are no
index 45228b0..d2789b1 100644 (file)
@@ -36,6 +36,7 @@ node_free (splay_tree_value value)
     gfc_free_iterator (c->iterator, 1);
 
   mpz_clear (c->offset);
+  mpz_clear (c->repeat);
 
   gfc_free (c);
 }
@@ -54,6 +55,7 @@ node_copy (splay_tree_node node, void *base)
   c->n.component = src->n.component;
 
   mpz_init_set (c->offset, src->offset);
+  mpz_init_set (c->repeat, src->repeat);
 
   return c;
 }
@@ -78,6 +80,7 @@ gfc_constructor_get (void)
   c->iterator = NULL;
 
   mpz_init_set_si (c->offset, 0);
+  mpz_init_set_si (c->repeat, 0);
 
   return c;
 }
@@ -169,6 +172,7 @@ gfc_constructor_insert_expr (gfc_constructor_base *base,
 gfc_constructor *
 gfc_constructor_lookup (gfc_constructor_base base, int offset)
 {
+  gfc_constructor *c;
   splay_tree_node node;
 
   if (!base)
@@ -178,7 +182,22 @@ gfc_constructor_lookup (gfc_constructor_base base, int offset)
   if (node)
     return (gfc_constructor*) node->value;
 
-  return NULL;
+  /* Check if the previous node as a repeat count big enough to
+     cover the offset looked for.  */
+  node = splay_tree_predecessor (base, offset);
+  if (!node)
+    return NULL;
+
+  c = (gfc_constructor*) node->value;
+  if (mpz_cmp_si (c->repeat, 1) > 0)
+    {
+      if (mpz_get_si (c->offset) + mpz_get_si (c->repeat) <= offset)
+       c = NULL;
+    }
+  else
+    c = NULL;
+
+  return c;
 }
 
 
index 6561cdc..fca251c 100644 (file)
@@ -154,10 +154,9 @@ create_character_intializer (gfc_expr *init, gfc_typespec *ts,
 
   if (len > end - start)
     {
-      gfc_warning_now ("Initialization string starting at %L was "
-                      "truncated to fit the variable (%d/%d)",
-                      &rvalue->where, end - start, len);
       len = end - start;
+      gfc_warning_now ("initialization string truncated to match variable "
+                      "at %L", &rvalue->where);
     }
 
   if (rvalue->ts.type == BT_HOLLERITH)
@@ -289,7 +288,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
          if (!con)
            {
              con = gfc_constructor_insert_expr (&expr->value.constructor,
-                                                NULL, &rvalue->where,
+                                                NULL, NULL,
                                                 mpz_get_si (offset));
            }
          break;
@@ -353,10 +352,8 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
          expr = (LOCATION_LINE (init->where.lb->location)
                  > LOCATION_LINE (rvalue->where.lb->location))
               ? init : rvalue;
-         if (gfc_notify_std (GFC_STD_GNU,"Extension: "
-                             "re-initialization of '%s' at %L",
-                             symbol->name, &expr->where) == FAILURE)
-           return FAILURE;
+         gfc_notify_std (GFC_STD_GNU, "Extension: re-initialization "
+                         "of '%s' at %L", symbol->name, &expr->where);
        }
 
       expr = gfc_copy_expr (rvalue);
@@ -374,34 +371,148 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
 
 
 /* Similarly, but initialize REPEAT consecutive values in LVALUE the same
-   value in RVALUE.  */
+   value in RVALUE.  For the nonce, LVALUE must refer to a full array, not
+   an array section.  */
 
-gfc_try
+void
 gfc_assign_data_value_range (gfc_expr *lvalue, gfc_expr *rvalue,
                             mpz_t index, mpz_t repeat)
 {
-  mpz_t offset, last_offset;
-  gfc_try t;
-
-  mpz_init (offset);
-  mpz_init (last_offset);
-  mpz_add (last_offset, index, repeat);
-
-  t = SUCCESS;
-  for (mpz_set(offset, index) ; mpz_cmp(offset, last_offset) < 0;
-                  mpz_add_ui (offset, offset, 1))
-    if (gfc_assign_data_value (lvalue, rvalue, offset) == FAILURE)
-      {
-       t = FAILURE;
-       break;
-      }
+  gfc_ref *ref;
+  gfc_expr *init, *expr;
+  gfc_constructor *con, *last_con;
+  gfc_symbol *symbol;
+  gfc_typespec *last_ts;
+  mpz_t offset;
 
-  mpz_clear (offset);
-  mpz_clear (last_offset);
+  symbol = lvalue->symtree->n.sym;
+  init = symbol->value;
+  last_ts = &symbol->ts;
+  last_con = NULL;
+  mpz_init_set_si (offset, 0);
 
-  return t;
-}
+  /* Find/create the parent expressions for subobject references.  */
+  for (ref = lvalue->ref; ref; ref = ref->next)
+    {
+      /* Use the existing initializer expression if it exists.
+        Otherwise create a new one.  */
+      if (init == NULL)
+       expr = gfc_get_expr ();
+      else
+       expr = init;
+
+      /* Find or create this element.  */
+      switch (ref->type)
+       {
+       case REF_ARRAY:
+         if (init == NULL)
+           {
+             /* The element typespec will be the same as the array
+                typespec.  */
+             expr->ts = *last_ts;
+             /* Setup the expression to hold the constructor.  */
+             expr->expr_type = EXPR_ARRAY;
+             expr->rank = ref->u.ar.as->rank;
+           }
+         else
+           gcc_assert (expr->expr_type == EXPR_ARRAY);
+
+         if (ref->u.ar.type == AR_ELEMENT)
+           {
+             get_array_index (&ref->u.ar, &offset);
+
+             /* This had better not be the bottom of the reference.
+                We can still get to a full array via a component.  */
+             gcc_assert (ref->next != NULL);
+           }
+         else
+           {
+             mpz_set (offset, index);
+
+             /* We're at a full array or an array section.  This means
+                that we've better have found a full array, and that we're
+                at the bottom of the reference.  */
+             gcc_assert (ref->u.ar.type == AR_FULL);
+             gcc_assert (ref->next == NULL);
+           }
+
+         con = gfc_constructor_lookup (expr->value.constructor,
+                                       mpz_get_si (offset));
+         if (con == NULL)
+           {
+             con = gfc_constructor_insert_expr (&expr->value.constructor,
+                                                NULL, NULL,
+                                                mpz_get_si (offset));
+             if (ref->next == NULL)
+               mpz_set (con->repeat, repeat);
+           }
+         else
+           gcc_assert (ref->next != NULL);
+         break;
 
+       case REF_COMPONENT:
+         if (init == NULL)
+           {
+             /* Setup the expression to hold the constructor.  */
+             expr->expr_type = EXPR_STRUCTURE;
+             expr->ts.type = BT_DERIVED;
+             expr->ts.u.derived = ref->u.c.sym;
+           }
+         else
+           gcc_assert (expr->expr_type == EXPR_STRUCTURE);
+         last_ts = &ref->u.c.component->ts;
+
+         /* Find the same element in the existing constructor.  */
+         con = find_con_by_component (ref->u.c.component,
+                                      expr->value.constructor);
+
+         if (con == NULL)
+           {
+             /* Create a new constructor.  */
+             con = gfc_constructor_append_expr (&expr->value.constructor,
+                                                NULL, NULL);
+             con->n.component = ref->u.c.component;
+           }
+
+         /* Since we're only intending to initialize arrays here,
+            there better be an inner reference.  */
+         gcc_assert (ref->next != NULL);
+         break;
+
+       case REF_SUBSTRING:
+       default:
+         gcc_unreachable ();
+       }
+
+      if (init == NULL)
+       {
+         /* Point the container at the new expression.  */
+         if (last_con == NULL)
+           symbol->value = expr;
+         else
+           last_con->expr = expr;
+       }
+      init = con->expr;
+      last_con = con;
+    }
+
+  if (last_ts->type == BT_CHARACTER)
+    expr = create_character_intializer (init, last_ts, NULL, rvalue);
+  else
+    {
+      /* We should never be overwriting an existing initializer.  */
+      gcc_assert (!init);
+
+      expr = gfc_copy_expr (rvalue);
+      if (!gfc_compare_types (&lvalue->ts, &expr->ts))
+       gfc_convert_type (expr, &lvalue->ts, 0);
+    }
+
+  if (last_con == NULL)
+    symbol->value = expr;
+  else
+    last_con->expr = expr;
+}
 
 /* Modify the index of array section and re-calculate the array offset.  */
 
index a9cd984..8851398 100644 (file)
@@ -25,7 +25,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "match.h"
 #include "parse.h"
 #include "flags.h"
-
+#include "constructor.h"
 
 /* Macros to access allocate memory for gfc_data_variable,
    gfc_data_value and gfc_data.  */
@@ -714,7 +714,7 @@ match_char_length (gfc_expr **expr)
       if (gfc_notify_std (GFC_STD_F95_OBS, "Obsolescent feature: "
                          "Old-style character length at %C") == FAILURE)
        return MATCH_ERROR;
-      *expr = gfc_int_expr (length);
+      *expr = gfc_get_int_expr (gfc_default_integer_kind, NULL, length);
       return m;
     }
 
@@ -1339,13 +1339,18 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
                  if (init->expr_type == EXPR_CONSTANT)
                    {
                      clen = init->value.character.length;
-                     sym->ts.u.cl->length = gfc_int_expr (clen);
+                     sym->ts.u.cl->length
+                               = gfc_get_int_expr (gfc_default_integer_kind,
+                                                   NULL, clen);
                    }
                  else if (init->expr_type == EXPR_ARRAY)
                    {
-                     gfc_expr *p = init->value.constructor->expr;
-                     clen = p->value.character.length;
-                     sym->ts.u.cl->length = gfc_int_expr (clen);
+                     gfc_constructor *c;
+                     c = gfc_constructor_first (init->value.constructor);
+                     clen = c->expr->value.character.length;
+                     sym->ts.u.cl->length
+                               = gfc_get_int_expr (gfc_default_integer_kind,
+                                                   NULL, clen);
                    }
                  else if (init->ts.u.cl && init->ts.u.cl->length)
                    sym->ts.u.cl->length =
@@ -1356,19 +1361,21 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
          else if (sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
            {
              int len = mpz_get_si (sym->ts.u.cl->length->value.integer);
-             gfc_constructor * p;
 
              if (init->expr_type == EXPR_CONSTANT)
                gfc_set_constant_character_len (len, init, -1);
              else if (init->expr_type == EXPR_ARRAY)
                {
+                 gfc_constructor *c;
+
                  /* Build a new charlen to prevent simplification from
                     deleting the length before it is resolved.  */
                  init->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
                  init->ts.u.cl->length = gfc_copy_expr (sym->ts.u.cl->length);
 
-                 for (p = init->value.constructor; p; p = p->next)
-                   gfc_set_constant_character_len (len, p->expr, -1);
+                 for (c = gfc_constructor_first (init->value.constructor);
+                      c; c = gfc_constructor_next (c))
+                   gfc_set_constant_character_len (len, c->expr, -1);
                }
            }
        }
@@ -1392,38 +1399,27 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
          if (init->ts.is_iso_c)
            sym->ts.f90_type = init->ts.f90_type;
        }
-      
+
       /* Add initializer.  Make sure we keep the ranks sane.  */
       if (sym->attr.dimension && init->rank == 0)
        {
          mpz_t size;
          gfc_expr *array;
-         gfc_constructor *c;
          int n;
          if (sym->attr.flavor == FL_PARAMETER
                && init->expr_type == EXPR_CONSTANT
                && spec_size (sym->as, &size) == SUCCESS
                && mpz_cmp_si (size, 0) > 0)
            {
-             array = gfc_start_constructor (init->ts.type, init->ts.kind,
-                                            &init->where);
-
-             array->value.constructor = c = NULL;
+             array = gfc_get_array_expr (init->ts.type, init->ts.kind,
+                                         &init->where);
              for (n = 0; n < (int)mpz_get_si (size); n++)
-               {
-                 if (array->value.constructor == NULL)
-                   {
-                     array->value.constructor = c = gfc_get_constructor ();
-                     c->expr = init;
-                   }
-                 else
-                   {
-                     c->next = gfc_get_constructor ();
-                     c = c->next;
-                     c->expr = gfc_copy_expr (init);
-                   }
-               }
-
+               gfc_constructor_append_expr (&array->value.constructor,
+                                            n == 0
+                                               ? init
+                                               : gfc_copy_expr (init),
+                                            &init->where);
+               
              array->shape = gfc_get_shape (sym->as->rank);
              for (n = 0; n < sym->as->rank; n++)
                spec_dimen_size (sym->as, n, &array->shape[n]);
@@ -1513,15 +1509,14 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
       else if (mpz_cmp (c->ts.u.cl->length->value.integer,
                        c->initializer->ts.u.cl->length->value.integer))
        {
-         bool has_ts;
-         gfc_constructor *ctor = c->initializer->value.constructor;
-
-         has_ts = (c->initializer->ts.u.cl
-                   && c->initializer->ts.u.cl->length_from_typespec);
+         gfc_constructor *ctor;
+         ctor = gfc_constructor_first (c->initializer->value.constructor);
 
          if (ctor)
            {
              int first_len;
+             bool has_ts = (c->initializer->ts.u.cl
+                            && c->initializer->ts.u.cl->length_from_typespec);
 
              /* Remember the length of the first element for checking
                 that all elements *in the constructor* have the same
@@ -1530,11 +1525,12 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
              gcc_assert (ctor->expr->ts.type == BT_CHARACTER);
              first_len = ctor->expr->value.character.length;
 
-             for (; ctor; ctor = ctor->next)
+             for ( ; ctor; ctor = gfc_constructor_next (ctor))
+               if (ctor->expr->expr_type == EXPR_CONSTANT)
                {
-                 if (ctor->expr->expr_type == EXPR_CONSTANT)
-                   gfc_set_constant_character_len (len, ctor->expr,
-                                                   has_ts ? -1 : first_len);
+                 gfc_set_constant_character_len (len, ctor->expr,
+                                                 has_ts ? -1 : first_len);
+                 ctor->expr->ts.u.cl->length = gfc_copy_expr (c->ts.u.cl->length);
                }
            }
        }
@@ -1586,7 +1582,6 @@ match
 gfc_match_null (gfc_expr **result)
 {
   gfc_symbol *sym;
-  gfc_expr *e;
   match m;
 
   m = gfc_match (" null ( )");
@@ -1608,12 +1603,7 @@ gfc_match_null (gfc_expr **result)
          || gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE))
     return MATCH_ERROR;
 
-  e = gfc_get_expr ();
-  e->where = gfc_current_locus;
-  e->expr_type = EXPR_NULL;
-  e->ts.type = BT_UNKNOWN;
-
-  *result = e;
+  *result = gfc_get_null_expr (&gfc_current_locus);
 
   return MATCH_YES;
 }
@@ -2309,7 +2299,7 @@ done:
   cl = gfc_new_charlen (gfc_current_ns, NULL);
 
   if (seen_length == 0)
-    cl->length = gfc_int_expr (1);
+    cl->length = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
   else
     cl->length = len;
 
@@ -2690,7 +2680,8 @@ gfc_match_implicit (void)
                {
                  ts.kind = gfc_default_character_kind;
                  ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
-                 ts.u.cl->length = gfc_int_expr (1);
+                 ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+                                                     NULL, 1);
                }
 
              /* Record the Successful match.  */
@@ -7147,12 +7138,7 @@ static gfc_expr *
 enum_initializer (gfc_expr *last_initializer, locus where)
 {
   gfc_expr *result;
-
-  result = gfc_get_expr ();
-  result->expr_type = EXPR_CONSTANT;
-  result->ts.type = BT_INTEGER;
-  result->ts.kind = gfc_c_int_kind;
-  result->where = where;
+  result = gfc_get_constant_expr (BT_INTEGER, gfc_c_int_kind, &where);
 
   mpz_init (result->value.integer);
 
index 6884c90..700fd10 100644 (file)
@@ -676,6 +676,36 @@ gfc_has_vector_index (gfc_expr *e)
 }
 
 
+/* Insert a reference to the component of the given name.
+   Only to be used with CLASS containers.  */
+
+void
+gfc_add_component_ref (gfc_expr *e, const char *name)
+{
+  gfc_ref **tail = &(e->ref);
+  gfc_ref *next = NULL;
+  gfc_symbol *derived = e->symtree->n.sym->ts.u.derived;
+  while (*tail != NULL)
+    {
+      if ((*tail)->type == REF_COMPONENT)
+       derived = (*tail)->u.c.component->ts.u.derived;
+      if ((*tail)->type == REF_ARRAY && (*tail)->next == NULL)
+       break;
+      tail = &((*tail)->next);
+    }
+  if (*tail != NULL && strcmp (name, "$data") == 0)
+    next = *tail;
+  (*tail) = gfc_get_ref();
+  (*tail)->next = next;
+  (*tail)->type = REF_COMPONENT;
+  (*tail)->u.c.sym = derived;
+  (*tail)->u.c.component = gfc_find_component (derived, name, true, true);
+  gcc_assert((*tail)->u.c.component);
+  if (!next)
+    e->ts = (*tail)->u.c.component->ts;
+}
+
+
 /* Copy a shape array.  */
 
 mpz_t *
@@ -1302,7 +1332,6 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
   int rank;
   int d;
   int shape_i;
-  int limit;
   long unsigned one = 1;
   bool incr_ctr;
   mpz_t start[GFC_MAX_DIMENSIONS];
@@ -1518,18 +1547,7 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
            }
        }
 
-      limit = mpz_get_ui (ptr);
-      if (limit >= gfc_option.flag_max_array_constructor)
-        {
-         gfc_error ("The number of elements in the array constructor "
-                    "at %L requires an increase of the allowed %d "
-                    "upper limit.   See -fmax-array-constructor "
-                    "option", &expr->where,
-                    gfc_option.flag_max_array_constructor);
-         return FAILURE;
-       }
-
-      cons = gfc_constructor_lookup (base, limit);
+      cons = gfc_constructor_lookup (base, mpz_get_ui (ptr));
       gcc_assert (cons);
       gfc_constructor_append_expr (&expr->value.constructor,
                                   gfc_copy_expr (cons->expr), NULL);
@@ -1865,7 +1883,7 @@ gfc_simplify_expr (gfc_expr *p, int type)
       /* Only substitute array parameter variables if we are in an
         initialization expression, or we want a subsection.  */
       if (p->symtree->n.sym->attr.flavor == FL_PARAMETER
-         && (gfc_init_expr_flag || p->ref
+         && (gfc_init_expr || p->ref
              || p->symtree->n.sym->value->expr_type != EXPR_ARRAY))
        {
          if (simplify_parameter_variable (p, type) == FAILURE)
@@ -2596,11 +2614,11 @@ gfc_reduce_init_expr (gfc_expr *expr)
 {
   gfc_try t;
 
-  gfc_init_expr_flag = true;
+  gfc_init_expr = 1;
   t = gfc_resolve_expr (expr);
   if (t == SUCCESS)
     t = check_init_expr (expr);
-  gfc_init_expr_flag = false;
+  gfc_init_expr = 0;
 
   if (t == FAILURE)
     return FAILURE;
@@ -2618,7 +2636,11 @@ gfc_reduce_init_expr (gfc_expr *expr)
 
 
 /* Match an initialization expression.  We work by first matching an
-   expression, then reducing it to a constant.  */
+   expression, then reducing it to a constant.  The reducing it to 
+   constant part requires a global variable to flag the prohibition
+   of a non-integer exponent in -std=f95 mode.  */
+
+bool init_flag = false;
 
 match
 gfc_match_init_expr (gfc_expr **result)
@@ -2629,12 +2651,12 @@ gfc_match_init_expr (gfc_expr **result)
 
   expr = NULL;
 
-  gfc_init_expr_flag = true;
+  init_flag = true;
 
   m = gfc_match_expr (&expr);
   if (m != MATCH_YES)
     {
-      gfc_init_expr_flag = false;
+      init_flag = false;
       return m;
     }
 
@@ -2642,12 +2664,12 @@ gfc_match_init_expr (gfc_expr **result)
   if (t != SUCCESS)
     {
       gfc_free_expr (expr);
-      gfc_init_expr_flag = false;
+      init_flag = false;
       return MATCH_ERROR;
     }
 
   *result = expr;
-  gfc_init_expr_flag = false;
+  init_flag = false;
 
   return MATCH_YES;
 }
@@ -3557,31 +3579,6 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_expr *rvalue)
 }
 
 
-/* Check for default initializer; sym->value is not enough
-   as it is also set for EXPR_NULL of allocatables.  */
-
-bool
-gfc_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)
-      {
-        if (!c->attr.pointer
-            && gfc_has_default_initializer (c->ts.u.derived))
-         return true;
-      }
-    else
-      {
-        if (c->initializer)
-         return true;
-      }
-
-  return false;
-}
-
 /* Get an expression for a default initializer.  */
 
 gfc_expr *
@@ -3590,8 +3587,7 @@ gfc_default_initializer (gfc_typespec *ts)
   gfc_expr *init;
   gfc_component *comp;
 
-  /* See if we have a default initializer in this, but not in nested
-     types (otherwise we could use gfc_has_default_initializer()).  */
+  /* See if we have a default initializer.  */
   for (comp = ts->u.derived->components; comp; comp = comp->next)
     if (comp->initializer || comp->attr.allocatable)
       break;
index 3668df4..a95134c 100644 (file)
@@ -1643,6 +1643,8 @@ gfc_class_esym_list;
 #define GFC_RND_MODE GMP_RNDN
 #define GFC_MPC_RND_MODE MPC_RNDNN
 
+typedef splay_tree gfc_constructor_base;
+
 typedef struct gfc_expr
 {
   expr_t expr_type;
@@ -1674,9 +1676,6 @@ typedef struct gfc_expr
      a function call in interface.c(gfc_extend_expr).  */
   unsigned int user_operator : 1;
 
-  /* Used to quickly find a given constructor by its offset.  */
-  splay_tree con_by_offset;
-
   /* If an expression comes from a Hollerith constant or compile-time
      evaluation of a transfer statement, it may have a prescribed target-
      memory representation, and these cannot always be backformed from
@@ -1745,7 +1744,7 @@ typedef struct gfc_expr
     }
     character;
 
-    struct gfc_constructor *constructor;
+    gfc_constructor_base constructor;
   }
   value;
 
@@ -2182,19 +2181,21 @@ extern gfc_option_t gfc_option;
 /* Constructor nodes for array and structure constructors.  */
 typedef struct gfc_constructor
 {
+  gfc_constructor_base base;
+  mpz_t offset;               /* Offset within a constructor, used as
+                                key within base. */
+
   gfc_expr *expr;
   gfc_iterator *iterator;
   locus where;
-  struct gfc_constructor *next;
-  struct
+
+  union
   {
-    mpz_t offset; /* Record the offset of array element which appears in
-                     data statement like "data a(5)/4/".  */
-    gfc_component *component; /* Record the component being initialized.  */
+     gfc_component *component; /* Record the component being initialized.  */
   }
   n;
   mpz_t repeat; /* Record the repeat number of initial values in data
-                 statement like "data a/5*10/".  */
+                  statement like "data a/5*10/".  */
 }
 gfc_constructor;
 
@@ -2610,10 +2611,18 @@ gfc_try gfc_simplify_expr (gfc_expr *, int);
 int gfc_has_vector_index (gfc_expr *);
 
 gfc_expr *gfc_get_expr (void);
+gfc_expr *gfc_get_array_expr (bt type, int kind, locus *);
+gfc_expr *gfc_get_null_expr (locus *);
+gfc_expr *gfc_get_operator_expr (locus *, gfc_intrinsic_op,gfc_expr *, gfc_expr *);
+gfc_expr *gfc_get_structure_constructor_expr (bt, int, locus *);
+gfc_expr *gfc_get_constant_expr (bt, int, locus *);
+gfc_expr *gfc_get_character_expr (int, locus *, const char *, int len);
+gfc_expr *gfc_get_int_expr (int, locus *, int);
+gfc_expr *gfc_get_logical_expr (int, locus *, bool);
+gfc_expr *gfc_get_iokind_expr (locus *, io_kind);
+
 void gfc_free_expr (gfc_expr *);
 void gfc_replace_expr (gfc_expr *, gfc_expr *);
-gfc_expr *gfc_int_expr (int);
-gfc_expr *gfc_logical_expr (int, locus *);
 mpz_t *gfc_copy_shape (mpz_t *, int);
 mpz_t *gfc_copy_shape_excluding (mpz_t *, int, gfc_expr *);
 gfc_expr *gfc_copy_expr (gfc_expr *);
@@ -2677,6 +2686,8 @@ bool gfc_type_is_extensible (gfc_symbol *sym);
 
 
 /* array.c */
+gfc_iterator *gfc_copy_iterator (gfc_iterator *);
+
 void gfc_free_array_spec (gfc_array_spec *);
 gfc_array_ref *gfc_copy_array_ref (gfc_array_ref *);
 
@@ -2686,9 +2697,6 @@ gfc_try gfc_resolve_array_spec (gfc_array_spec *, int);
 
 int gfc_compare_array_spec (gfc_array_spec *, gfc_array_spec *);
 
-gfc_expr *gfc_start_constructor (bt, int, locus *);
-void gfc_append_constructor (gfc_expr *, gfc_expr *);
-void gfc_free_constructor (gfc_constructor *);
 void gfc_simplify_iterator_var (gfc_expr *);
 gfc_try gfc_expand_constructor (gfc_expr *);
 int gfc_constant_ac (gfc_expr *);
@@ -2698,14 +2706,10 @@ gfc_try gfc_resolve_array_constructor (gfc_expr *);
 gfc_try gfc_check_constructor_type (gfc_expr *);
 gfc_try gfc_check_iter_variable (gfc_expr *);
 gfc_try gfc_check_constructor (gfc_expr *, gfc_try (*)(gfc_expr *));
-gfc_constructor *gfc_copy_constructor (gfc_constructor *);
-gfc_expr *gfc_get_array_element (gfc_expr *, int);
 gfc_try gfc_array_size (gfc_expr *, mpz_t *);
 gfc_try gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
 gfc_try gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
 gfc_array_ref *gfc_find_array_ref (gfc_expr *);
-void gfc_insert_constructor (gfc_expr *, gfc_constructor *);
-gfc_constructor *gfc_get_constructor (void);
 tree gfc_conv_array_initializer (tree type, gfc_expr *);
 gfc_try spec_size (gfc_array_spec *, mpz_t *);
 gfc_try spec_dimen_size (gfc_array_spec *, int, mpz_t *);
index 2709de7..ea1134a 100644 (file)
@@ -1,5 +1,6 @@
 /* Matching subroutines in all sizes, shapes and colors.
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+   2009, 2010
    2010 Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -1005,7 +1006,7 @@ gfc_match_iterator (gfc_iterator *iter, int init_flag)
 
   if (gfc_match_char (',') != MATCH_YES)
     {
-      e3 = gfc_int_expr (1);
+      e3 = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
       goto done;
     }
 
@@ -1826,7 +1827,7 @@ gfc_match_do (void)
 
   if (gfc_match_eos () == MATCH_YES)
     {
-      iter.end = gfc_logical_expr (1, NULL);
+      iter.end = gfc_get_logical_expr (gfc_default_logical_kind, NULL, true);
       new_st.op = EXEC_DO_WHILE;
       goto done;
     }
@@ -2464,7 +2465,8 @@ gfc_match_goto (void)
        }
 
       cp = gfc_get_case ();
-      cp->low = cp->high = gfc_int_expr (i++);
+      cp->low = cp->high = gfc_get_int_expr (gfc_default_integer_kind,
+                                            NULL, i++);
 
       tail->op = EXEC_SELECT;
       tail->ext.case_list = cp;
@@ -2944,10 +2946,7 @@ gfc_match_nullify (void)
        }
 
       /* build ' => NULL() '.  */
-      e = gfc_get_expr ();
-      e->where = gfc_current_locus;
-      e->expr_type = EXPR_NULL;
-      e->ts.type = BT_UNKNOWN;
+      e = gfc_get_null_expr (&gfc_current_locus);
 
       /* Chain to list.  */
       if (tail == NULL)
@@ -3355,7 +3354,8 @@ gfc_match_call (void)
          c->op = EXEC_SELECT;
 
          new_case = gfc_get_case ();
-         new_case->high = new_case->low = gfc_int_expr (i);
+         new_case->high = gfc_get_int_expr (gfc_default_integer_kind, NULL, i);
+         new_case->low = new_case->high;
          c->ext.case_list = new_case;
 
          c->next = gfc_get_code ();
@@ -4786,7 +4786,7 @@ match_forall_iterator (gfc_forall_iterator **result)
     goto cleanup;
 
   if (gfc_match_char (':') == MATCH_NO)
-    iter->stride = gfc_int_expr (1);
+    iter->stride = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
   else
     {
       m = gfc_match_expr (&iter->stride);
index ac572c8..c58a67c 100644 (file)
@@ -73,6 +73,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "match.h"
 #include "parse.h" /* FIXME */
 #include "md5.h"
+#include "constructor.h"
 
 #define MODULE_EXTENSION ".mod"
 
@@ -2628,15 +2629,15 @@ done:
 
 
 static void
-mio_constructor (gfc_constructor **cp)
+mio_constructor (gfc_constructor_base *cp)
 {
-  gfc_constructor *c, *tail;
+  gfc_constructor *c;
 
   mio_lparen ();
 
   if (iomode == IO_OUTPUT)
     {
-      for (c = *cp; c; c = c->next)
+      for (c = gfc_constructor_first (*cp); c; c = gfc_constructor_next (c))
        {
          mio_lparen ();
          mio_expr (&c->expr);
@@ -2646,19 +2647,9 @@ mio_constructor (gfc_constructor **cp)
     }
   else
     {
-      *cp = NULL;
-      tail = NULL;
-
       while (peek_atom () != ATOM_RPAREN)
        {
-         c = gfc_get_constructor ();
-
-         if (tail == NULL)
-           *cp = c;
-         else
-           tail->next = c;
-
-         tail = c;
+         c = gfc_constructor_append_expr (cp, NULL, NULL);
 
          mio_lparen ();
          mio_expr (&c->expr);
@@ -5343,7 +5334,7 @@ create_int_parameter (const char *name, int value, const char *modname,
   sym->attr.flavor = FL_PARAMETER;
   sym->ts.type = BT_INTEGER;
   sym->ts.kind = gfc_default_integer_kind;
-  sym->value = gfc_int_expr (value);
+  sym->value = gfc_get_int_expr (gfc_default_integer_kind, NULL, value);
   sym->attr.use_assoc = 1;
   sym->from_intmod = module;
   sym->intmod_sym_id = id;
index 5e9b25c..2831149 100644 (file)
@@ -29,6 +29,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "dependency.h"
 #include "data.h"
 #include "target-memory.h" /* for gfc_simplify_transfer */
+#include "constructor.h"
 
 /* Types used in equivalence statements.  */
 
@@ -227,7 +228,8 @@ resolve_formal_arglist (gfc_symbol *proc)
        {
          sym->as->type = AS_ASSUMED_SHAPE;
          for (i = 0; i < sym->as->rank; i++)
-           sym->as->lower[i] = gfc_int_expr (1);
+           sym->as->lower[i] = gfc_get_int_expr (gfc_default_integer_kind,
+                                                 NULL, 1);
        }
 
       if ((sym->as && sym->as->rank > 0 && sym->as->type == AS_ASSUMED_SHAPE)
@@ -841,7 +843,7 @@ resolve_structure_cons (gfc_expr *expr)
   symbol_attribute a;
 
   t = SUCCESS;
-  cons = expr->value.constructor;
+  cons = gfc_constructor_first (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.  */
@@ -867,7 +869,7 @@ resolve_structure_cons (gfc_expr *expr)
       && cons->expr && cons->expr->expr_type == EXPR_NULL)
     return SUCCESS;
 
-  for (; comp; comp = comp->next, cons = cons->next)
+  for (; comp && cons; comp = comp->next, cons = gfc_constructor_next (cons))
     {
       int rank;
 
@@ -4309,7 +4311,7 @@ gfc_resolve_substring_charlen (gfc_expr *e)
   if (char_ref->u.ss.start)
     start = gfc_copy_expr (char_ref->u.ss.start);
   else
-    start = gfc_int_expr (1);
+    start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
 
   if (char_ref->u.ss.end)
     end = gfc_copy_expr (char_ref->u.ss.end);
@@ -4323,7 +4325,9 @@ gfc_resolve_substring_charlen (gfc_expr *e)
 
   /* 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_int_expr (1));
+  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->ts.type = BT_INTEGER;
   e->ts.u.cl->length->ts.kind = gfc_charlen_int_kind;
@@ -4820,12 +4824,14 @@ gfc_resolve_character_operator (gfc_expr *e)
   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_int_expr (op1->value.character.length);
+    e1 = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+                          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_int_expr (op2->value.character.length);
+    e2 = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+                          op2->value.character.length);
 
   e->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
 
@@ -5690,15 +5696,16 @@ gfc_is_expandable_expr (gfc_expr *e)
       /* Traverse the constructor looking for variables that are flavor
         parameter.  Parameters must be expanded since they are fully used at
         compile time.  */
-      for (con = e->value.constructor; con; con = con->next)
+      con = gfc_constructor_first (e->value.constructor);
+      for (; con; con = gfc_constructor_next (con))
        {
          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;
        }
     }
@@ -7282,12 +7289,14 @@ resolve_select_type (gfc_code *code)
   for (body = code->block; body; body = body->block)
     {
       c = body->ext.case_list;
-      
+
       if (c->ts.type == BT_DERIVED)
-       c->low = c->high = gfc_int_expr (c->ts.u.derived->hash_value);
+       c->low = c->high = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+                                            c->ts.u.derived->hash_value);
+
       else if (c->ts.type == BT_UNKNOWN)
        continue;
-      
+
       /* Assign temporary to selector.  */
       if (c->ts.type == BT_CLASS)
        sprintf (name, "tmp$class$%s", c->ts.u.derived->name);
@@ -7543,7 +7552,8 @@ resolve_sync (gfc_code *code)
               && gfc_simplify_expr (code->expr1, 0) == SUCCESS)
        {
           gfc_constructor *cons;
-          for (cons = code->expr1->value.constructor; cons; cons = cons->next)
+          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 "
@@ -8895,7 +8905,8 @@ resolve_charlen (gfc_charlen *cl)
        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_int_expr (0));
+      gfc_replace_expr (cl->length,
+                       gfc_get_int_expr (gfc_default_integer_kind, NULL, 0));
     }
 
   /* Check that the character length is not too large.  */
@@ -9027,12 +9038,9 @@ build_default_init_expr (gfc_symbol *sym)
     return NULL;
 
   /* Now we'll try to build an initializer expression.  */
-  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;
-  
+  init_expr = gfc_get_constant_expr (sym->ts.type, sym->ts.kind,
+                                    &sym->declared_at);
+
   /* We will only initialize integers, reals, complex, logicals, and
      characters, and only if the corresponding command-line flags
      were set.  Otherwise, we free init_expr and return null.  */
@@ -12398,7 +12406,8 @@ resolve_equivalence (gfc_equiv *eq)
                {
                  ref->type = REF_SUBSTRING;
                  if (start == NULL)
-                   start = gfc_int_expr (1);
+                   start = gfc_get_int_expr (gfc_default_integer_kind,
+                                             NULL, 1);
                  ref->u.ss.start = start;
                  if (end == NULL && e->ts.u.cl)
                    end = gfc_copy_expr (e->ts.u.cl->length);
index 60fbf01..b909b1c 100644 (file)
@@ -2722,14 +2722,13 @@ gfc_simplify_kind (gfc_expr *e)
 
 static gfc_expr *
 simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper,
-                   gfc_array_spec *as, gfc_ref *ref, bool coarray)
+                   gfc_array_spec *as, gfc_ref *ref)
 {
   gfc_expr *l, *u, *result;
   int k;
 
   /* The last dimension of an assumed-size array is special.  */
-  if ((!coarray && d == as->rank && as->type == AS_ASSUMED_SIZE && !upper)
-      || (coarray && d == as->rank + as->corank))
+  if (d == as->rank && as->type == AS_ASSUMED_SIZE && !upper)
     {
       if (as->lower[d-1]->expr_type == EXPR_CONSTANT)
        return gfc_copy_expr (as->lower[d-1]);
@@ -2746,13 +2745,12 @@ simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper,
 
 
   /* Then, we need to know the extent of the given dimension.  */
-  if (coarray || ref->u.ar.type == AR_FULL)
+  if (ref->u.ar.type == AR_FULL)
     {
       l = as->lower[d-1];
       u = as->upper[d-1];
 
-      if (l->expr_type != EXPR_CONSTANT || u == NULL
-         || u->expr_type != EXPR_CONSTANT)
+      if (l->expr_type != EXPR_CONSTANT || u->expr_type != EXPR_CONSTANT)
        return NULL;
 
       if (mpz_cmp (l->value.integer, u->value.integer) > 0)
@@ -2863,8 +2861,7 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
       /* Simplify the bounds for each dimension.  */
       for (d = 0; d < array->rank; d++)
        {
-         bounds[d] = simplify_bound_dim (array, kind, d + 1, upper, as, ref,
-                                         false);
+         bounds[d] = simplify_bound_dim (array, kind, d + 1, upper, as, ref);
          if (bounds[d] == NULL || bounds[d] == &gfc_bad_expr)
            {
              int j;
@@ -2911,138 +2908,7 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
          return &gfc_bad_expr;
        }
 
-      return simplify_bound_dim (array, kind, d, upper, as, ref, false);
-    }
-}
-
-
-static gfc_expr *
-simplify_cobound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
-{
-  gfc_ref *ref;
-  gfc_array_spec *as;
-  int d;
-
-  if (array->expr_type != EXPR_VARIABLE)
-    return NULL;
-
-  /* Follow any component references.  */
-  as = array->symtree->n.sym->as;
-  for (ref = array->ref; ref; ref = ref->next)
-    {
-      switch (ref->type)
-       {
-       case REF_ARRAY:
-         switch (ref->u.ar.type)
-           {
-           case AR_ELEMENT:
-             if (ref->next == NULL)
-               {
-                 gcc_assert (ref->u.ar.as->corank > 0
-                             && ref->u.ar.as->rank == 0);
-                 as = ref->u.ar.as;
-                 goto done;
-               }
-             as = NULL;
-             continue;
-
-           case AR_FULL:
-             /* We're done because 'as' has already been set in the
-                previous iteration.  */
-             if (!ref->next)
-               goto done;
-
-           /* Fall through.  */
-
-           case AR_UNKNOWN:
-             return NULL;
-
-           case AR_SECTION:
-             as = ref->u.ar.as;
-             goto done;
-           }
-
-         gcc_unreachable ();
-
-       case REF_COMPONENT:
-         as = ref->u.c.component->as;
-         continue;
-
-       case REF_SUBSTRING:
-         continue;
-       }
-    }
-
-  gcc_unreachable ();
-
- done:
-
-  if (as->type == AS_DEFERRED || as->type == AS_ASSUMED_SHAPE)
-    return NULL;
-
-  if (dim == NULL)
-    {
-      /* Multi-dimensional cobounds.  */
-      gfc_expr *bounds[GFC_MAX_DIMENSIONS];
-      gfc_expr *e;
-      int k;
-
-      /* Simplify the cobounds for each dimension.  */
-      for (d = 0; d < as->corank; d++)
-       {
-         bounds[d] = simplify_bound_dim (array, kind, d + 1 + array->rank,
-                                         upper, as, ref, true);
-         if (bounds[d] == NULL || bounds[d] == &gfc_bad_expr)
-           {
-             int j;
-
-             for (j = 0; j < d; j++)
-               gfc_free_expr (bounds[j]);
-             return bounds[d];
-           }
-       }
-
-      /* Allocate the result expression.  */
-      e = gfc_get_expr ();
-      e->where = array->where;
-      e->expr_type = EXPR_ARRAY;
-      e->ts.type = BT_INTEGER;
-      k = get_kind (BT_INTEGER, kind, upper ? "UCOBOUND" : "LCOBOUND",
-                   gfc_default_integer_kind); 
-      if (k == -1)
-       {
-         gfc_free_expr (e);
-         return &gfc_bad_expr;
-       }
-      e->ts.kind = k;
-
-      /* The result is a rank 1 array; its size is the rank of the first
-        argument to {L,U}COBOUND.  */
-      e->rank = 1;
-      e->shape = gfc_get_shape (1);
-      mpz_init_set_ui (e->shape[0], as->corank);
-
-      /* Create the constructor for this array.  */
-      for (d = 0; d < as->corank; d++)
-       gfc_constructor_append_expr (&e->value.constructor,
-                                    bounds[d], &e->where);
-      return e;
-    }
-  else
-    {
-      /* A DIM argument is specified.  */
-      if (dim->expr_type != EXPR_CONSTANT)
-       return NULL;
-
-      d = mpz_get_si (dim->value.integer);
-
-      if (d < 1 || d > as->corank)
-       {
-         gfc_error ("DIM argument at %L is out of bounds", &dim->where);
-         return &gfc_bad_expr;
-       }
-
-      return simplify_bound_dim (array, kind, d+array->rank, upper, as, ref, true);
+      return simplify_bound_dim (array, kind, d, upper, as, ref);
     }
 }
 
@@ -3055,21 +2921,6 @@ gfc_simplify_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 
 
 gfc_expr *
-gfc_simplify_lcobound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
-{
-  gfc_expr *e;
-  /* return simplify_cobound (array, dim, kind, 0);*/
-
-  e = simplify_cobound (array, dim, kind, 0);
-  if (e != NULL)
-    return e;
-
-  gfc_error ("Not yet implemented: LCOBOUND for coarray with non-constant "
-            "cobounds at %L", &array->where);
-  return &gfc_bad_expr;
-}
-
-gfc_expr *
 gfc_simplify_leadz (gfc_expr *e)
 {
   unsigned long lz, bs;
@@ -3852,13 +3703,6 @@ gfc_expr *
 gfc_simplify_num_images (void)
 {
   gfc_expr *result;
-
-  if (gfc_option.coarray == GFC_FCOARRAY_NONE)
-    {
-      gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable");
-      return &gfc_bad_expr;
-    }
-
   /* FIXME: gfc_current_locus is wrong.  */
   result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
                                  &gfc_current_locus);
@@ -3868,17 +3712,6 @@ gfc_simplify_num_images (void)
 
 
 gfc_expr *
-gfc_simplify_num_images (void)
-{
-  gfc_expr *result;
-  /* FIXME: gfc_current_locus is wrong.  */
-  result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind, &gfc_current_locus);
-  mpz_set_si (result->value.integer, 1);
-  return result;
-}
-
-
-gfc_expr *
 gfc_simplify_or (gfc_expr *x, gfc_expr *y)
 {
   gfc_expr *result;
@@ -5191,7 +5024,7 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
   unsigned char *buffer;
 
   if (!gfc_is_constant_expr (source)
-       || (gfc_init_expr_flag && !gfc_is_constant_expr (mold))
+       || (gfc_init_expr && !gfc_is_constant_expr (mold))
        || !gfc_is_constant_expr (size))
     return NULL;
 
@@ -5341,248 +5174,11 @@ gfc_simplify_trim (gfc_expr *e)
 
 
 gfc_expr *
-gfc_simplify_image_index (gfc_expr *coarray, gfc_expr *sub)
-{
-  gfc_expr *result;
-  gfc_ref *ref;
-  gfc_array_spec *as;
-  gfc_constructor *sub_cons;
-  bool first_image;
-  int d;
-
-  if (!is_constant_array_expr (sub))
-    goto not_implemented; /* return NULL;*/
-
-  /* Follow any component references.  */
-  as = coarray->symtree->n.sym->as;
-  for (ref = coarray->ref; ref; ref = ref->next)
-    if (ref->type == REF_COMPONENT)
-      as = ref->u.ar.as;
-
-  if (as->type == AS_DEFERRED)
-    goto not_implemented; /* return NULL;*/
-
-  /* "valid sequence of cosubscripts" are required; thus, return 0 unless
-     the cosubscript addresses the first image.  */
-
-  sub_cons = gfc_constructor_first (sub->value.constructor);
-  first_image = true;
-
-  for (d = 1; d <= as->corank; d++)
-    {
-      gfc_expr *ca_bound;
-      int cmp;
-
-      if (sub_cons == NULL)
-       {
-         gfc_error ("Too few elements in expression for SUB= argument at %L",
-                    &sub->where);
-         return &gfc_bad_expr;
-       }
-
-      ca_bound = simplify_bound_dim (coarray, NULL, d + as->rank, 0, as,
-                                    NULL, true);
-      if (ca_bound == NULL)
-       goto not_implemented; /* return NULL */
-
-      if (ca_bound == &gfc_bad_expr)
-       return ca_bound;
-
-      cmp = mpz_cmp (ca_bound->value.integer, sub_cons->expr->value.integer);
-
-      if (cmp == 0)
-       {
-          gfc_free_expr (ca_bound);
-         sub_cons = gfc_constructor_next (sub_cons);
-         continue;
-       }
-
-      first_image = false;
-
-      if (cmp > 0)
-       {
-         gfc_error ("Out of bounds in IMAGE_INDEX at %L for dimension %d, "
-                    "SUB has %ld and COARRAY lower bound is %ld)",
-                    &coarray->where, d,
-                    mpz_get_si (sub_cons->expr->value.integer),
-                    mpz_get_si (ca_bound->value.integer));
-         gfc_free_expr (ca_bound);
-         return &gfc_bad_expr;
-       }
-
-      gfc_free_expr (ca_bound);
-
-      /* Check whether upperbound is valid for the multi-images case.  */
-      if (d < as->corank)
-       {
-         ca_bound = simplify_bound_dim (coarray, NULL, d + as->rank, 1, as,
-                                        NULL, true);
-         if (ca_bound == &gfc_bad_expr)
-           return ca_bound;
-
-         if (ca_bound && ca_bound->expr_type == EXPR_CONSTANT
-             && mpz_cmp (ca_bound->value.integer,
-                         sub_cons->expr->value.integer) < 0)
-         {
-           gfc_error ("Out of bounds in IMAGE_INDEX at %L for dimension %d, "
-                      "SUB has %ld and COARRAY upper bound is %ld)",
-                      &coarray->where, d,
-                      mpz_get_si (sub_cons->expr->value.integer),
-                      mpz_get_si (ca_bound->value.integer));
-           gfc_free_expr (ca_bound);
-           return &gfc_bad_expr;
-         }
-
-         if (ca_bound)
-           gfc_free_expr (ca_bound);
-       }
-
-      sub_cons = gfc_constructor_next (sub_cons);
-    }
-
-  if (sub_cons != NULL)
-    {
-      gfc_error ("Too many elements in expression for SUB= argument at %L",
-                &sub->where);
-      return &gfc_bad_expr;
-    }
-
-  result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
-                                 &gfc_current_locus);
-  if (first_image)
-    mpz_set_si (result->value.integer, 1);
-  else
-    mpz_set_si (result->value.integer, 0);
-
-  return result;
-
-not_implemented:
-  gfc_error ("Not yet implemented: IMAGE_INDEX for coarray with non-constant "
-            "cobounds at %L", &coarray->where);
-  return &gfc_bad_expr;
-}
-
-
-gfc_expr *
-gfc_simplify_this_image (gfc_expr *coarray, gfc_expr *dim)
-{
-  gfc_ref *ref;
-  gfc_array_spec *as;
-  int d;
-
-  if (coarray == NULL)
-    {
-      gfc_expr *result;
-      /* FIXME: gfc_current_locus is wrong.  */
-      result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
-                                     &gfc_current_locus);
-      mpz_set_si (result->value.integer, 1);
-      return result;
-    }
-
-  gcc_assert (coarray->expr_type == EXPR_VARIABLE);
-
-  /* Follow any component references.  */
-  as = coarray->symtree->n.sym->as;
-  for (ref = coarray->ref; ref; ref = ref->next)
-    if (ref->type == REF_COMPONENT)
-      as = ref->u.ar.as;
-
-  if (as->type == AS_DEFERRED)
-    goto not_implemented; /* return NULL;*/
-
-  if (dim == NULL)
-    {
-      /* Multi-dimensional bounds.  */
-      gfc_expr *bounds[GFC_MAX_DIMENSIONS];
-      gfc_expr *e;
-
-      /* Simplify the bounds for each dimension.  */
-      for (d = 0; d < as->corank; d++)
-       {
-         bounds[d] = simplify_bound_dim (coarray, NULL, d + as->rank + 1, 0,
-                                         as, NULL, true);
-         if (bounds[d] == NULL || bounds[d] == &gfc_bad_expr)
-           {
-             int j;
-
-             for (j = 0; j < d; j++)
-               gfc_free_expr (bounds[j]);
-             if (bounds[d] == NULL)
-               goto not_implemented;
-             return bounds[d];
-           }
-       }
-
-      /* Allocate the result expression.  */
-      e = gfc_get_expr ();
-      e->where = coarray->where;
-      e->expr_type = EXPR_ARRAY;
-      e->ts.type = BT_INTEGER;
-      e->ts.kind = gfc_default_integer_kind;
-
-      e->rank = 1;
-      e->shape = gfc_get_shape (1);
-      mpz_init_set_ui (e->shape[0], as->corank);
-
-      /* Create the constructor for this array.  */
-      for (d = 0; d < as->corank; d++)
-        gfc_constructor_append_expr (&e->value.constructor,
-                                     bounds[d], &e->where);
-
-      return e;
-    }
-  else
-    {
-      gfc_expr *e;
-      /* A DIM argument is specified.  */
-      if (dim->expr_type != EXPR_CONSTANT)
-       goto not_implemented; /*return NULL;*/
-
-      d = mpz_get_si (dim->value.integer);
-
-      if (d < 1 || d > as->corank)
-       {
-         gfc_error ("DIM argument at %L is out of bounds", &dim->where);
-         return &gfc_bad_expr;
-       }
-
-      /*return simplify_bound_dim (coarray, NULL, d + as->rank, 0, as, NULL, true);*/
-      e = simplify_bound_dim (coarray, NULL, d + as->rank, 0, as, NULL, true);
-      if (e != NULL)
-       return e;
-      else
-       goto not_implemented;
-   }
-
-not_implemented:
-  gfc_error ("Not yet implemented: THIS_IMAGE for coarray with non-constant "
-            "cobounds at %L", &coarray->where);
-  return &gfc_bad_expr;
-}
-
-
-gfc_expr *
 gfc_simplify_ubound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 {
   return simplify_bound (array, dim, kind, 1);
 }
 
-gfc_expr *
-gfc_simplify_ucobound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
-{
-  gfc_expr *e;
-  /* return simplify_cobound (array, dim, kind, 1);*/
-
-  e = simplify_cobound (array, dim, kind, 1);
-  if (e != NULL)
-    return e;
-
-  gfc_error ("Not yet implemented: UCOBOUND for coarray with non-constant "
-            "cobounds at %L", &array->where);
-  return &gfc_bad_expr;
-}
-
 
 gfc_expr *
 gfc_simplify_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field)
index dbbc97c..4356845 100644 (file)
@@ -27,6 +27,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "gfortran.h"
 #include "parse.h"
 #include "match.h"
+#include "constructor.h"
 
 
 /* Strings for all symbol attributes.  We use these for dumping the
@@ -3664,6 +3665,7 @@ gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
 {
   gfc_symtree *tmp_symtree;
   gfc_symbol *tmp_sym;
+  gfc_constructor *c;
 
   tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, ptr_name);
         
@@ -3725,10 +3727,11 @@ gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
   tmp_sym->value->expr_type = EXPR_STRUCTURE;
   tmp_sym->value->ts.type = BT_DERIVED;
   tmp_sym->value->ts.u.derived = tmp_sym->ts.u.derived;
-  tmp_sym->value->value.constructor = gfc_get_constructor ();
-  tmp_sym->value->value.constructor->expr = gfc_get_expr ();
-  tmp_sym->value->value.constructor->expr->expr_type = EXPR_NULL;
-  tmp_sym->value->value.constructor->expr->ts.is_iso_c = 1;
+  gfc_constructor_append_expr (&tmp_sym->value->value.constructor, NULL, NULL);
+  c = gfc_constructor_first (tmp_sym->value->value.constructor);
+  c->expr = gfc_get_expr ();
+  c->expr->expr_type = EXPR_NULL;
+  c->expr->ts.is_iso_c = 1;
   /* Must declare c_null_ptr and c_null_funptr as having the
      PARAMETER attribute so they can be used in init expressions.  */
   tmp_sym->attr.flavor = FL_PARAMETER;
@@ -3934,7 +3937,8 @@ gen_shape_param (gfc_formal_arglist **head,
       param_sym->as->upper[i] = NULL;
     }
   param_sym->as->rank = 1;
-  param_sym->as->lower[0] = gfc_int_expr (1);
+  param_sym->as->lower[0] = gfc_get_int_expr (gfc_default_integer_kind,
+                                             NULL, 1);
 
   /* The extent is unknown until we get it.  The length give us
      the rank the incoming pointer.  */
@@ -4277,7 +4281,8 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
 #define NAMED_CHARKNDCST(a,b,c) case a :
 #include "iso-c-binding.def"
 
-       tmp_sym->value = gfc_int_expr (c_interop_kinds_table[s].value);
+       tmp_sym->value = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+                                          c_interop_kinds_table[s].value);
 
        /* Initialize an integer constant expression node.  */
        tmp_sym->attr.flavor = FL_PARAMETER;
@@ -4307,20 +4312,16 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
 
        /* Initialize an integer constant expression node for the
           length of the character.  */
-       tmp_sym->value = gfc_get_expr (); 
-       tmp_sym->value->expr_type = EXPR_CONSTANT;
-       tmp_sym->value->ts.type = BT_CHARACTER;
-       tmp_sym->value->ts.kind = gfc_default_character_kind;
-       tmp_sym->value->where = gfc_current_locus;
+       tmp_sym->value = gfc_get_character_expr (gfc_default_character_kind,
+                                                &gfc_current_locus, NULL, 1);
        tmp_sym->value->ts.is_c_interop = 1;
        tmp_sym->value->ts.is_iso_c = 1;
        tmp_sym->value->value.character.length = 1;
-       tmp_sym->value->value.character.string = gfc_get_wide_string (2);
        tmp_sym->value->value.character.string[0]
          = (gfc_char_t) c_interop_kinds_table[s].value;
-       tmp_sym->value->value.character.string[1] = '\0';
        tmp_sym->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
-       tmp_sym->ts.u.cl->length = gfc_int_expr (1);
+       tmp_sym->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+                                                    NULL, 1);
 
        /* May not need this in both attr and ts, but do need in
           attr for writing module file.  */
@@ -4756,8 +4757,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
       c->attr.codimension = attr->codimension;
       c->attr.abstract = ts->u.derived->attr.abstract;
       c->as = (*as);
-      c->initializer = gfc_get_expr ();
-      c->initializer->expr_type = EXPR_NULL;
+      c->initializer = gfc_get_null_expr (NULL);
 
       /* Add component '$vptr'.  */
       if (gfc_add_component (fclass, "$vptr", &c) == FAILURE)
@@ -4767,8 +4767,6 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
       gcc_assert (vtab);
       c->ts.u.derived = vtab->ts.u.derived;
       c->attr.pointer = 1;
-      c->initializer = gfc_get_expr ();
-      c->initializer->expr_type = EXPR_NULL;
     }
 
   /* Since the extension field is 8 bit wide, we can only have
@@ -4842,7 +4840,8 @@ gfc_find_derived_vtab (gfc_symbol *derived)
              c->ts.type = BT_INTEGER;
              c->ts.kind = 4;
              c->attr.access = ACCESS_PRIVATE;
-             c->initializer = gfc_int_expr (derived->hash_value);
+             c->initializer = gfc_get_int_expr (gfc_default_integer_kind,
+                                                NULL, derived->hash_value);
 
              /* Add component '$size'.  */
              if (gfc_add_component (vtype, "$size", &c) == FAILURE)
@@ -4854,20 +4853,21 @@ gfc_find_derived_vtab (gfc_symbol *derived)
                 so that the correct initializer can be set later on
                 (in gfc_conv_structure).  */
              c->ts.u.derived = derived;
-             c->initializer = gfc_int_expr (0);
+             c->initializer = gfc_get_int_expr (gfc_default_integer_kind,
+                                                NULL, 0);
 
              /* Add component $extends.  */
              if (gfc_add_component (vtype, "$extends", &c) == FAILURE)
                return NULL;
              c->attr.pointer = 1;
              c->attr.access = ACCESS_PRIVATE;
-             c->initializer = gfc_get_expr ();
              parent = gfc_get_derived_super_type (derived);
              if (parent)
                {
                  parent_vtab = gfc_find_derived_vtab (parent);
                  c->ts.type = BT_DERIVED;
                  c->ts.u.derived = parent_vtab->ts.u.derived;
+                 c->initializer = gfc_get_expr ();
                  c->initializer->expr_type = EXPR_VARIABLE;
                  gfc_find_sym_tree (parent_vtab->name, parent_vtab->ns, 0,
                                     &c->initializer->symtree);
@@ -4876,7 +4876,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
                {
                  c->ts.type = BT_DERIVED;
                  c->ts.u.derived = vtype;
-                 c->initializer->expr_type = EXPR_NULL;
+                 c->initializer = gfc_get_null_expr (NULL);
                }
            }
          vtab->ts.u.derived = vtype;
index cbdd8b9..0380049 100644 (file)
@@ -86,6 +86,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "real.h"
 #include "flags.h"
 #include "gfortran.h"
+#include "constructor.h"
 #include "trans.h"
 #include "trans-stmt.h"
 #include "trans-types.h"
@@ -94,7 +95,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "dependency.h"
 
 static gfc_ss *gfc_walk_subexpr (gfc_ss *, gfc_expr *);
-static bool gfc_get_array_constructor_size (mpz_t *, gfc_constructor *);
+static bool gfc_get_array_constructor_size (mpz_t *, gfc_constructor_base);
 
 /* The contents of this structure aren't actually used, just the address.  */
 static gfc_ss gfc_ss_terminator_var;
@@ -1014,8 +1015,9 @@ gfc_get_array_constructor_element_size (mpz_t * size, gfc_expr * expr)
    of array constructor C.  */
 
 static bool
-gfc_get_array_constructor_size (mpz_t * size, gfc_constructor * c)
+gfc_get_array_constructor_size (mpz_t * size, gfc_constructor_base base)
 {
+  gfc_constructor *c;
   gfc_iterator *i;
   mpz_t val;
   mpz_t len;
@@ -1026,7 +1028,7 @@ gfc_get_array_constructor_size (mpz_t * size, gfc_constructor * c)
   mpz_init (val);
 
   dynamic = false;
-  for (; c; c = c->next)
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
     {
       i = c->iterator;
       if (i && gfc_iterator_has_dynamic_bounds (i))
@@ -1231,7 +1233,7 @@ gfc_trans_array_constructor_subarray (stmtblock_t * pblock,
 
 static void
 gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
-                                  tree desc, gfc_constructor * c,
+                                  tree desc, gfc_constructor_base base,
                                   tree * poffset, tree * offsetvar,
                                   bool dynamic)
 {
@@ -1239,12 +1241,13 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
   stmtblock_t body;
   gfc_se se;
   mpz_t size;
+  gfc_constructor *c;
 
   tree shadow_loopvar = NULL_TREE;
   gfc_saved_var saved_loopvar;
 
   mpz_init (size);
-  for (; c; c = c->next)
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
     {
       /* If this is an iterator or an array, the offset must be a variable.  */
       if ((c->iterator || c->expr->rank > 0) && INTEGER_CST_P (*poffset))
@@ -1289,7 +1292,7 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
          n = 0;
          while (p && !(p->iterator || p->expr->expr_type != EXPR_CONSTANT))
            {
-             p = p->next;
+             p = gfc_constructor_next (p);
              n++;
            }
          if (n < 4)
@@ -1332,7 +1335,7 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
                  list = tree_cons (build_int_cst (gfc_array_index_type,
                                                   idx++), se.expr, list);
                  c = p;
-                 p = p->next;
+                 p = gfc_constructor_next (p);
                }
 
              bound = build_int_cst (NULL_TREE, n - 1);
@@ -1585,13 +1588,14 @@ get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len)
    Returns TRUE if all elements are character constants.  */
 
 bool
-get_array_ctor_strlen (stmtblock_t *block, gfc_constructor * c, tree * len)
+get_array_ctor_strlen (stmtblock_t *block, gfc_constructor_base base, tree * len)
 {
+  gfc_constructor *c;
   bool is_const;
-  
+
   is_const = TRUE;
 
-  if (c == NULL)
+  if (gfc_constructor_first (base) == NULL)
     {
       if (len)
        *len = build_int_cstu (gfc_charlen_type_node, 0);
@@ -1601,7 +1605,8 @@ get_array_ctor_strlen (stmtblock_t *block, gfc_constructor * c, tree * len)
   /* Loop over all constructor elements to find out is_const, but in len we
      want to store the length of the first, not the last, element.  We can
      of course exit the loop as soon as is_const is found to be false.  */
-  for (; c && is_const; c = c->next)
+  for (c = gfc_constructor_first (base);
+       c && is_const; c = gfc_constructor_next (c))
     {
       switch (c->expr->expr_type)
        {
@@ -1641,17 +1646,18 @@ get_array_ctor_strlen (stmtblock_t *block, gfc_constructor * c, tree * len)
    return zero.  Note, an empty or NULL array constructor returns zero.  */
 
 unsigned HOST_WIDE_INT
-gfc_constant_array_constructor_p (gfc_constructor * c)
+gfc_constant_array_constructor_p (gfc_constructor_base base)
 {
   unsigned HOST_WIDE_INT nelem = 0;
 
+  gfc_constructor *c = gfc_constructor_first (base);
   while (c)
     {
       if (c->iterator
          || c->expr->rank > 0
          || c->expr->expr_type != EXPR_CONSTANT)
        return 0;
-      c = c->next;
+      c = gfc_constructor_next (c);
       nelem++;
     }
   return nelem;
@@ -1676,7 +1682,7 @@ gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
      to tree to build an initializer.  */
   nelem = 0;
   list = NULL_TREE;
-  c = expr->value.constructor;
+  c = gfc_constructor_first (expr->value.constructor);
   while (c)
     {
       gfc_init_se (&se, NULL);
@@ -1688,7 +1694,7 @@ gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
                                       se.expr);
       list = tree_cons (build_int_cst (gfc_array_index_type, nelem),
                        se.expr, list);
-      c = c->next;
+      c = gfc_constructor_next (c);
       nelem++;
     }
 
@@ -1702,15 +1708,17 @@ gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
   as.type = AS_EXPLICIT;
   if (!expr->shape)
     {
-      as.lower[0] = gfc_int_expr (0);
-      as.upper[0] = gfc_int_expr (nelem - 1);
+      as.lower[0] = gfc_get_int_expr (gfc_default_integer_kind, NULL, 0);
+      as.upper[0] = gfc_get_int_expr (gfc_default_integer_kind,
+                                     NULL, nelem - 1);
     }
   else
     for (i = 0; i < expr->rank; i++)
       {
        int tmp = (int) mpz_get_si (expr->shape[i]);
-       as.lower[i] = gfc_int_expr (0);
-       as.upper[i] = gfc_int_expr (tmp - 1);
+        as.lower[i] = gfc_get_int_expr (gfc_default_integer_kind, NULL, 0);
+        as.upper[i] = gfc_get_int_expr (gfc_default_integer_kind,
+                                       NULL, tmp - 1);
       }
 
   tmptype = gfc_get_nodesc_array_type (type, &as, PACKED_STATIC, true);
@@ -1807,7 +1815,7 @@ constant_array_constructor_loop_size (gfc_loopinfo * loop)
 static void
 gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
 {
-  gfc_constructor *c;
+  gfc_constructor_base c;
   tree offset;
   tree offsetvar;
   tree desc;
@@ -3557,7 +3565,6 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
   tree tmp;
   gfc_ss *loopspec[GFC_MAX_DIMENSIONS];
   bool dynamic[GFC_MAX_DIMENSIONS];
-  gfc_constructor *c;
   mpz_t *cshape;
   mpz_t i;
 
@@ -3582,6 +3589,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
 
          if (ss->type == GFC_SS_CONSTRUCTOR)
            {
+             gfc_constructor_base base;
              /* An unknown size constructor will always be rank one.
                 Higher rank constructors will either have known shape,
                 or still be wrapped in a call to reshape.  */
@@ -3591,8 +3599,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
                 can be determined at compile time.  Prefer not to otherwise,
                 since the general case involves realloc, and it's better to
                 avoid that overhead if possible.  */
-             c = ss->expr->value.constructor;
-             dynamic[n] = gfc_get_array_constructor_size (&i, c);
+             base = ss->expr->value.constructor;
+             dynamic[n] = gfc_get_array_constructor_size (&i, base);
              if (!dynamic[n] || !loopspec[n])
                loopspec[n] = ss;
              continue;
@@ -4117,7 +4125,8 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr)
 
     case EXPR_ARRAY:
       /* Create a vector of all the elements.  */
-      for (c = expr->value.constructor; c; c = c->next)
+      for (c = gfc_constructor_first (expr->value.constructor);
+          c; c = gfc_constructor_next (c))
         {
           if (c->iterator)
             {
@@ -4130,8 +4139,8 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr)
                               gfc_option.flag_max_array_constructor);
              return NULL_TREE;
            }
-          if (mpz_cmp_si (c->n.offset, 0) != 0)
-            index = gfc_conv_mpz_to_tree (c->n.offset, gfc_index_integer_kind);
+          if (mpz_cmp_si (c->offset, 0) != 0)
+            index = gfc_conv_mpz_to_tree (c->offset, gfc_index_integer_kind);
           else
             index = NULL_TREE;
          mpz_init (maxval);
@@ -4140,16 +4149,16 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr)
               tree tmp1, tmp2;
 
               mpz_set (maxval, c->repeat);
-              mpz_add (maxval, c->n.offset, maxval);
+              mpz_add (maxval, c->offset, maxval);
               mpz_sub_ui (maxval, maxval, 1);
               tmp2 = gfc_conv_mpz_to_tree (maxval, gfc_index_integer_kind);
-              if (mpz_cmp_si (c->n.offset, 0) != 0)
+              if (mpz_cmp_si (c->offset, 0) != 0)
                 {
-                  mpz_add_ui (maxval, c->n.offset, 1);
+                  mpz_add_ui (maxval, c->offset, 1);
                   tmp1 = gfc_conv_mpz_to_tree (maxval, gfc_index_integer_kind);
                 }
               else
-                tmp1 = gfc_conv_mpz_to_tree (c->n.offset, gfc_index_integer_kind);
+                tmp1 = gfc_conv_mpz_to_tree (c->offset, gfc_index_integer_kind);
 
               range = fold_build2 (RANGE_EXPR, integer_type_node, tmp1, tmp2);
             }
index 53c4b47..658aadb 100644 (file)
@@ -38,6 +38,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "debug.h"
 #include "gfortran.h"
 #include "pointer-set.h"
+#include "constructor.h"
 #include "trans.h"
 #include "trans-types.h"
 #include "trans-array.h"
@@ -3578,7 +3579,8 @@ check_constant_initializer (gfc_expr *expr, gfc_typespec *ts, bool array,
        return check_constant_initializer (expr, ts, false, false);
       else if (expr->expr_type != EXPR_ARRAY)
        return false;
-      for (c = expr->value.constructor; c; c = c->next)
+      for (c = gfc_constructor_first (expr->value.constructor);
+          c; c = gfc_constructor_next (c))
        {
          if (c->iterator)
            return false;
@@ -3598,7 +3600,8 @@ check_constant_initializer (gfc_expr *expr, gfc_typespec *ts, bool array,
       if (expr->expr_type != EXPR_STRUCTURE)
        return false;
       cm = expr->ts.u.derived->components;
-      for (c = expr->value.constructor; c; c = c->next, cm = cm->next)
+      for (c = gfc_constructor_first (expr->value.constructor);
+          c; c = gfc_constructor_next (c), cm = cm->next)
        {
          if (!c->expr || cm->attr.allocatable)
            continue;
index 10716b7..42e1d34 100644 (file)
@@ -35,6 +35,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "flags.h"
 #include "gfortran.h"
 #include "arith.h"
+#include "constructor.h"
 #include "trans.h"
 #include "trans-const.h"
 #include "trans-types.h"
@@ -278,11 +279,14 @@ flatten_array_ctors_without_strlen (gfc_expr* e)
       /* We've found what we're looking for.  */
       if (e->ts.type == BT_CHARACTER && !e->ts.u.cl->length)
        {
+         gfc_constructor *c;
          gfc_expr* new_expr;
+
          gcc_assert (e->value.constructor);
 
-         new_expr = e->value.constructor->expr;
-         e->value.constructor->expr = NULL;
+         c = gfc_constructor_first (e->value.constructor);
+         new_expr = c->expr;
+         c->expr = NULL;
 
          flatten_array_ctors_without_strlen (new_expr);
          gfc_replace_expr (e, new_expr);
@@ -291,7 +295,8 @@ flatten_array_ctors_without_strlen (gfc_expr* e)
 
       /* Otherwise, fall through to handle constructor elements.  */
     case EXPR_STRUCTURE:
-      for (c = e->value.constructor; c; c = c->next)
+      for (c = gfc_constructor_first (e->value.constructor);
+          c; c = gfc_constructor_next (c))
        flatten_array_ctors_without_strlen (c->expr);
       break;
 
@@ -1432,7 +1437,8 @@ gfc_conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr)
          gfc_typespec ts;
           gfc_clear_ts (&ts);
 
-         *expr = gfc_int_expr ((int)(*expr)->value.character.string[0]);
+         *expr = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+                                   (int)(*expr)->value.character.string[0]);
          if ((*expr)->ts.kind != gfc_c_int_kind)
            {
              /* The expr needs to be compatible with a C int.  If the 
@@ -1991,9 +1997,10 @@ gfc_finish_interface_mapping (gfc_interface_mapping * mapping,
 
 static void
 gfc_apply_interface_mapping_to_cons (gfc_interface_mapping * mapping,
-                                    gfc_constructor * c)
+                                    gfc_constructor_base base)
 {
-  for (; c; c = c->next)
+  gfc_constructor *c;
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
     {
       gfc_apply_interface_mapping_to_expr (mapping, c->expr);
       if (c->iterator)
@@ -2101,7 +2108,9 @@ gfc_map_intrinsic_function (gfc_expr *expr, gfc_interface_mapping *mapping)
              return false;
            }
 
-         tmp = gfc_add (gfc_copy_expr (sym->as->upper[d]), gfc_int_expr (1));
+         tmp = gfc_add (gfc_copy_expr (sym->as->upper[d]),
+                                       gfc_get_int_expr (gfc_default_integer_kind,
+                                                         NULL, 1));
          tmp = gfc_subtract (tmp, gfc_copy_expr (sym->as->lower[d]));
          if (new_expr)
            new_expr = gfc_multiply (new_expr, tmp);
@@ -3984,12 +3993,10 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type,
     {
       gfc_symbol *derived = expr->ts.u.derived;
 
-      expr = gfc_int_expr (0);
-
       /* The derived symbol has already been converted to a (void *).  Use
         its kind.  */
+      expr = gfc_get_int_expr (derived->ts.kind, NULL, 0);
       expr->ts.f90_type = derived->ts.f90_type;
-      expr->ts.kind = derived->ts.kind;
 
       gfc_init_se (&se, NULL);
       gfc_conv_constant (&se, expr);
@@ -4389,7 +4396,8 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr)
 
   gfc_start_block (&block);
   cm = expr->ts.u.derived->components;
-  for (c = expr->value.constructor; c; c = c->next, cm = cm->next)
+  for (c = gfc_constructor_first (expr->value.constructor);
+       c; c = gfc_constructor_next (c), cm = cm->next)
     {
       /* Skip absent members in default initializers.  */
       if (!c->expr)
@@ -4445,7 +4453,8 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init)
 
   cm = expr->ts.u.derived->components;
 
-  for (c = expr->value.constructor; c; c = c->next, cm = cm->next)
+  for (c = gfc_constructor_first (expr->value.constructor);
+       c; c = gfc_constructor_next (c), cm = cm->next)
     {
       /* Skip absent members in default initializers and allocatable
         components.  Although the latter have a default initializer
@@ -5619,7 +5628,7 @@ gfc_trans_class_assign (gfc_code *code)
          rhs->ts = vtab->ts;
        }
       else if (code->expr2->expr_type == EXPR_NULL)
-       rhs = gfc_int_expr (0);
+       rhs = gfc_get_int_expr (gfc_default_integer_kind, NULL, 0);
       else
        gcc_unreachable ();
 
index fe34f69..782ff1d 100644 (file)
@@ -450,7 +450,7 @@ extern GTY(()) tree gfc_static_ctors;
 void gfc_generate_constructors (void);
 
 /* Get the string length of an array constructor.  */
-bool get_array_ctor_strlen (stmtblock_t *, gfc_constructor *, tree *);
+bool get_array_ctor_strlen (stmtblock_t *, gfc_constructor_base, tree *);
 
 /* Generate a runtime error call.  */
 tree gfc_trans_runtime_error (bool, locus*, const char*, ...);