diff options
author | Paul Thomas <pault@gcc.gnu.org> | 2017-09-10 17:02:53 +0000 |
---|---|---|
committer | Paul Thomas <pault@gcc.gnu.org> | 2017-09-10 17:02:53 +0000 |
commit | ff3598bc73dbae3a612709daca41e56ab5aa6928 (patch) | |
tree | 83cec48b6de78db0f46a3c655690f575a6ab84ca /gcc/fortran | |
parent | 7368cfa4986d83317fbfb839b1eeb249a9ef7199 (diff) | |
download | gcc-ff3598bc73dbae3a612709daca41e56ab5aa6928.zip gcc-ff3598bc73dbae3a612709daca41e56ab5aa6928.tar.gz gcc-ff3598bc73dbae3a612709daca41e56ab5aa6928.tar.bz2 |
re PR fortran/34640 (ICE when assigning item of a derived-component to a pointer)
2017-09-10 Paul Thomas <pault@gcc.gnu.org>
PR fortran/34640
PR fortran/40737
PR fortran/55763
PR fortran/57019
PR fortran/57116
* expr.c (is_subref_array): Add class pointer array dummies
to the list of expressions that return true.
* trans-array.c: Add SPAN_FIELD and update indices for
subsequent fields.
(gfc_conv_descriptor_span, gfc_conv_descriptor_span_get,
gfc_conv_descriptor_span_set, is_pointer_array,
get_array_span): New functions.
(gfc_get_descriptor_offsets_for_info): New function to preserve
API for access to descriptor fields for trans-types.c.
(gfc_conv_scalarized_array_ref): If the expression is a subref
array, make sure that info->descriptor is a descriptor type.
Otherwise, if info->descriptor is a pointer array, set 'decl'
and fix it if it is a component reference.
(build_array_ref): Simplify handling of class array refs by
passing the vptr to gfc_build_array_ref rather than generating
the pointer arithmetic in this function.
(gfc_conv_array_ref): As in gfc_conv_scalarized_array_ref, set
'decl'.
(gfc_array_allocate): Set the span field if this is a pointer
array. Use the expr3 element size if it is available, so that
the dynamic type element size is used.
(gfc_conv_expr_descriptor): Set the span field for pointer
assignments.
* trans-array.h: Prototypes for gfc_conv_descriptor_span_get
gfc_conv_descriptor_span_set and
gfc_get_descriptor_offsets_for_info added.
trans-decl.c (gfc_get_symbol_decl): If a non-class pointer
array, mark the declaration as a GFC_DECL_PTR_ARRAY_P. Remove
the setting of GFC_DECL_SPAN.
(gfc_trans_deferred_vars): Set the span field to zero in thge
originating scope.
* trans-expr.c (gfc_conv_procedure_call): Do not use copy-in/
copy-out to pass subref expressions to a pointer dummy.
(gfc_trans_pointer_assignment): Remove code for setting of
GFC_DECL_SPAN. Set the 'span' field for non-class pointers to
class function results. Likewise for rank remap. In the case
that the target is not a whole array, use the target array ref
for remap and, since the 'start' indices are missing, set the
lbounds to one, as required by the standard.
* trans-intrinsic.c (conv_expr_ref_to_caf_ref): Pick up the
'token' offset from the field decl in the descriptor.
(conv_isocbinding_subroutine): Set the 'span' field.
* trans-io.c (gfc_trans_transfer): Always scalarize pointer
array io.
* trans-stmt.c (trans_associate_var): Set the 'span' field.
* trans-types.c (gfc_get_array_descriptor_base): Add the 'span'
field to the array descriptor.
(gfc_get_derived_type): Pointer array components are marked as
GFC_DECL_PTR_ARRAY_P.
(gfc_get_array_descr_info): Replaced API breaking code for
descriptor offset calling gfc_get_descriptor_offsets_for_info.
* trans.c (get_array_span): New function.
(gfc_build_array_ref): Simplify by calling get_array_span and
obtain 'span' if 'decl' or 'vptr' present.
* trans.h : Rename DECL_LANG_FLAG_6, GFC_DECL_SUBREF_ARRAY_P,
as GFC_DECL_PTR_ARRAY_P.
2017-09-10 Paul Thomas <pault@gcc.gnu.org>
PR fortran/34640
* gfortran.dg/associate_24.f90: New test.
* gfortran.dg/assumed_type_2.f90: Adjust some of the tree dump
checks.
* gfortran.dg/no_arg_check_2.f90: Likewise.
* gfortran.dg/pointer_array_1.f90: New test.
* gfortran.dg/pointer_array_2.f90: New test.
* gfortran.dg/pointer_array_7.f90: New test.
* gfortran.dg/pointer_array_8.f90: New test.
* gfortran.dg/pointer_array_component_1.f90: New test.
* gfortran.dg/pointer_array_component_2.f90: New test.
* gfortran.dg/goacc/kernels-alias-4.f95: Bump up both tree scan
counts by 1.
PR fortran/40737
* gfortran.dg/pointer_array_3.f90: New test.
PR fortran/57116
* gfortran.dg/pointer_array_4.f90: New test.
PR fortran/55763
* gfortran.dg/pointer_array_5.f90: New test.
PR fortran/57019
* gfortran.dg/pointer_array_6.f90: New test.
2017-09-10 Paul Thomas <pault@gcc.gnu.org>
PR fortran/34640
* libgfortran/libgfortran.h: Add span field to descriptor.
* libgfortran/libtool-version : Bump up version number to 5:0:0.
From-SVN: r251949
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 65 | ||||
-rw-r--r-- | gcc/fortran/expr.c | 5 | ||||
-rw-r--r-- | gcc/fortran/trans-array.c | 258 | ||||
-rw-r--r-- | gcc/fortran/trans-array.h | 5 | ||||
-rw-r--r-- | gcc/fortran/trans-decl.c | 40 | ||||
-rw-r--r-- | gcc/fortran/trans-expr.c | 69 | ||||
-rw-r--r-- | gcc/fortran/trans-intrinsic.c | 12 | ||||
-rw-r--r-- | gcc/fortran/trans-io.c | 9 | ||||
-rw-r--r-- | gcc/fortran/trans-stmt.c | 19 | ||||
-rw-r--r-- | gcc/fortran/trans-types.c | 37 | ||||
-rw-r--r-- | gcc/fortran/trans.c | 139 | ||||
-rw-r--r-- | gcc/fortran/trans.h | 2 |
12 files changed, 488 insertions, 172 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 140caf5..20fae5a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,68 @@ +2017-09-10 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/34640 + PR fortran/40737 + PR fortran/55763 + PR fortran/57019 + PR fortran/57116 + + * expr.c (is_subref_array): Add class pointer array dummies + to the list of expressions that return true. + * trans-array.c: Add SPAN_FIELD and update indices for + subsequent fields. + (gfc_conv_descriptor_span, gfc_conv_descriptor_span_get, + gfc_conv_descriptor_span_set, is_pointer_array, + get_array_span): New functions. + (gfc_get_descriptor_offsets_for_info): New function to preserve + API for access to descriptor fields for trans-types.c. + (gfc_conv_scalarized_array_ref): If the expression is a subref + array, make sure that info->descriptor is a descriptor type. + Otherwise, if info->descriptor is a pointer array, set 'decl' + and fix it if it is a component reference. + (build_array_ref): Simplify handling of class array refs by + passing the vptr to gfc_build_array_ref rather than generating + the pointer arithmetic in this function. + (gfc_conv_array_ref): As in gfc_conv_scalarized_array_ref, set + 'decl'. + (gfc_array_allocate): Set the span field if this is a pointer + array. Use the expr3 element size if it is available, so that + the dynamic type element size is used. + (gfc_conv_expr_descriptor): Set the span field for pointer + assignments. + * trans-array.h: Prototypes for gfc_conv_descriptor_span_get + gfc_conv_descriptor_span_set and + gfc_get_descriptor_offsets_for_info added. + trans-decl.c (gfc_get_symbol_decl): If a non-class pointer + array, mark the declaration as a GFC_DECL_PTR_ARRAY_P. Remove + the setting of GFC_DECL_SPAN. + (gfc_trans_deferred_vars): Set the span field to zero in thge + originating scope. + * trans-expr.c (gfc_conv_procedure_call): Do not use copy-in/ + copy-out to pass subref expressions to a pointer dummy. + (gfc_trans_pointer_assignment): Remove code for setting of + GFC_DECL_SPAN. Set the 'span' field for non-class pointers to + class function results. Likewise for rank remap. In the case + that the target is not a whole array, use the target array ref + for remap and, since the 'start' indices are missing, set the + lbounds to one, as required by the standard. + * trans-intrinsic.c (conv_expr_ref_to_caf_ref): Pick up the + 'token' offset from the field decl in the descriptor. + (conv_isocbinding_subroutine): Set the 'span' field. + * trans-io.c (gfc_trans_transfer): Always scalarize pointer + array io. + * trans-stmt.c (trans_associate_var): Set the 'span' field. + * trans-types.c (gfc_get_array_descriptor_base): Add the 'span' + field to the array descriptor. + (gfc_get_derived_type): Pointer array components are marked as + GFC_DECL_PTR_ARRAY_P. + (gfc_get_array_descr_info): Replaced API breaking code for + descriptor offset calling gfc_get_descriptor_offsets_for_info. + * trans.c (get_array_span): New function. + (gfc_build_array_ref): Simplify by calling get_array_span and + obtain 'span' if 'decl' or 'vptr' present. + * trans.h : Rename DECL_LANG_FLAG_6, GFC_DECL_SUBREF_ARRAY_P, + as GFC_DECL_PTR_ARRAY_P. + 2017-09-09 Paul Thomas <pault@gcc.gnu.org> * decl.c : Add decl_type_param_list, type_param_spec_list as diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 079a2ba..35df29c 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -995,6 +995,11 @@ is_subref_array (gfc_expr * e) if (e->symtree->n.sym->attr.subref_array_pointer) return true; + if (e->symtree->n.sym->ts.type == BT_CLASS + && e->symtree->n.sym->attr.dummy + && CLASS_DATA (e->symtree->n.sym)->attr.class_pointer) + return true; + seen_array = false; for (ref = e->ref; ref; ref = ref->next) { diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 2b06903..328da4e 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -125,8 +125,9 @@ gfc_array_dataptr_type (tree desc) #define DATA_FIELD 0 #define OFFSET_FIELD 1 #define DTYPE_FIELD 2 -#define DIMENSION_FIELD 3 -#define CAF_TOKEN_FIELD 4 +#define SPAN_FIELD 3 +#define DIMENSION_FIELD 4 +#define CAF_TOKEN_FIELD 5 #define STRIDE_SUBFIELD 0 #define LBOUND_SUBFIELD 1 @@ -244,6 +245,36 @@ gfc_conv_descriptor_dtype (tree desc) desc, field, NULL_TREE); } +static tree +gfc_conv_descriptor_span (tree desc) +{ + tree type; + tree field; + + type = TREE_TYPE (desc); + gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); + + field = gfc_advance_chain (TYPE_FIELDS (type), SPAN_FIELD); + gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); + + return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), + desc, field, NULL_TREE); +} + +tree +gfc_conv_descriptor_span_get (tree desc) +{ + return gfc_conv_descriptor_span (desc); +} + +void +gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, + tree value) +{ + tree t = gfc_conv_descriptor_span (desc); + gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value)); +} + tree gfc_conv_descriptor_rank (tree desc) @@ -466,11 +497,41 @@ gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree desc, } +/* Obtain offsets for trans-types.c(gfc_get_array_descr_info). */ + +void +gfc_get_descriptor_offsets_for_info (const_tree desc_type, tree *data_off, + tree *dtype_off, tree *dim_off, + tree *dim_size, tree *stride_suboff, + tree *lower_suboff, tree *upper_suboff) +{ + tree field; + tree type; + + type = TYPE_MAIN_VARIANT (desc_type); + field = gfc_advance_chain (TYPE_FIELDS (type), OFFSET_FIELD); + *data_off = byte_position (field); + field = gfc_advance_chain (TYPE_FIELDS (type), DTYPE_FIELD); + *dtype_off = byte_position (field); + field = gfc_advance_chain (TYPE_FIELDS (type), DIMENSION_FIELD); + *dim_off = byte_position (field); + type = TREE_TYPE (TREE_TYPE (field)); + *dim_size = TYPE_SIZE_UNIT (type); + field = gfc_advance_chain (TYPE_FIELDS (type), STRIDE_SUBFIELD); + *stride_suboff = byte_position (field); + field = gfc_advance_chain (TYPE_FIELDS (type), LBOUND_SUBFIELD); + *lower_suboff = byte_position (field); + field = gfc_advance_chain (TYPE_FIELDS (type), UBOUND_SUBFIELD); + *upper_suboff = byte_position (field); +} + + /* Cleanup those #defines. */ #undef DATA_FIELD #undef OFFSET_FIELD #undef DTYPE_FIELD +#undef SPAN_FIELD #undef DIMENSION_FIELD #undef CAF_TOKEN_FIELD #undef STRIDE_SUBFIELD @@ -720,6 +781,84 @@ gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head) } +/* Returns true if the expression is an array pointer. */ + +static bool +is_pointer_array (tree expr) +{ + if (flag_openmp) + return false; + + if (expr == NULL_TREE + || !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr)) + || GFC_CLASS_TYPE_P (TREE_TYPE (expr))) + return false; + + if (TREE_CODE (expr) == VAR_DECL + && GFC_DECL_PTR_ARRAY_P (expr)) + return true; + + if (TREE_CODE (expr) == PARM_DECL + && GFC_DECL_PTR_ARRAY_P (expr)) + return true; + + if (TREE_CODE (expr) == INDIRECT_REF + && GFC_DECL_PTR_ARRAY_P (TREE_OPERAND (expr, 0))) + return true; + + /* The field declaration is marked as an pointer array. */ + if (TREE_CODE (expr) == COMPONENT_REF + && GFC_DECL_PTR_ARRAY_P (TREE_OPERAND (expr, 1)) + && !GFC_CLASS_TYPE_P (TREE_TYPE (TREE_OPERAND (expr, 1)))) + return true; + + return false; +} + + +/* Return the span of an array. */ + +static tree +get_array_span (tree desc, gfc_expr *expr) +{ + tree tmp; + + if (is_pointer_array (desc)) + /* This will have the span field set. */ + tmp = gfc_conv_descriptor_span_get (desc); + else if (TREE_CODE (desc) == COMPONENT_REF + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)) + && GFC_CLASS_TYPE_P (TREE_TYPE (TREE_OPERAND (desc, 0)))) + { + /* The descriptor is a class _data field and so use the vtable + size for the receiving span field. */ + tmp = gfc_get_vptr_from_expr (desc); + tmp = gfc_vptr_size_get (tmp); + } + else if (expr && expr->expr_type == EXPR_VARIABLE + && expr->symtree->n.sym->ts.type == BT_CLASS + && expr->ref->type == REF_COMPONENT + && expr->ref->next->type == REF_ARRAY + && expr->ref->next->next == NULL + && CLASS_DATA (expr->symtree->n.sym)->attr.dimension) + { + /* Dummys come in sometimes with the descriptor detached from + the class field or declaration. */ + tmp = gfc_class_vptr_get (expr->symtree->n.sym->backend_decl); + tmp = gfc_vptr_size_get (tmp); + } + else + { + /* If none of the fancy stuff works, the span is the element + size of the array. */ + tmp = gfc_get_element_type (TREE_TYPE (desc)); + tmp = fold_convert (gfc_array_index_type, + size_in_bytes (tmp)); + } + return tmp; +} + + /* Generate an initializer for a static pointer or allocatable array. */ void @@ -3239,11 +3378,30 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) index = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, index, info->offset); - if (expr && (is_subref_array (expr) + if (expr && ((is_subref_array (expr) + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (info->descriptor))) || (expr->ts.deferred && (expr->expr_type == EXPR_VARIABLE || expr->expr_type == EXPR_FUNCTION)))) decl = expr->symtree->n.sym->backend_decl; + /* A pointer array component can be detected from its field decl. Fix + the descriptor, mark the resulting variable decl and pass it to + gfc_build_array_ref. */ + if (is_pointer_array (info->descriptor)) + { + if (TREE_CODE (info->descriptor) == COMPONENT_REF) + { + decl = gfc_evaluate_now (info->descriptor, &se->pre); + GFC_DECL_PTR_ARRAY_P (decl) = 1; + TREE_USED (decl) = 1; + } + else if (TREE_CODE (info->descriptor) == INDIRECT_REF) + decl = TREE_OPERAND (info->descriptor, 0); + + if (decl == NULL_TREE) + decl = info->descriptor; + } + tmp = build_fold_indirect_ref_loc (input_location, info->data); /* Use the vptr 'size' field to access a class the element of a class @@ -3288,45 +3446,27 @@ build_array_ref (tree desc, tree offset, tree decl, tree vptr) { tree tmp; tree type; - tree cdecl; - bool classarray = false; + tree cdesc; /* For class arrays the class declaration is stored in the saved descriptor. */ if (INDIRECT_REF_P (desc) && DECL_LANG_SPECIFIC (TREE_OPERAND (desc, 0)) && GFC_DECL_SAVED_DESCRIPTOR (TREE_OPERAND (desc, 0))) - cdecl = gfc_class_data_get (GFC_DECL_SAVED_DESCRIPTOR ( + cdesc = gfc_class_data_get (GFC_DECL_SAVED_DESCRIPTOR ( TREE_OPERAND (desc, 0))); else - cdecl = desc; + cdesc = desc; /* Class container types do not always have the GFC_CLASS_TYPE_P but the canonical type does. */ - if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (cdecl)) - && TREE_CODE (cdecl) == COMPONENT_REF) + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (cdesc)) + && TREE_CODE (cdesc) == COMPONENT_REF) { - type = TREE_TYPE (TREE_OPERAND (cdecl, 0)); + type = TREE_TYPE (TREE_OPERAND (cdesc, 0)); if (TYPE_CANONICAL (type) && GFC_CLASS_TYPE_P (TYPE_CANONICAL (type))) - { - type = TREE_TYPE (desc); - classarray = true; - } - } - else - type = NULL; - - /* Class array references need special treatment because the assigned - type size needs to be used to point to the element. */ - if (classarray) - { - type = gfc_get_element_type (type); - tmp = TREE_OPERAND (cdecl, 0); - tmp = gfc_get_class_array_ref (offset, tmp, NULL_TREE); - tmp = fold_convert (build_pointer_type (type), tmp); - tmp = build_fold_indirect_ref_loc (input_location, tmp); - return tmp; + vptr = gfc_class_vptr_get (TREE_OPERAND (cdesc, 0)); } tmp = gfc_conv_array_data (desc); @@ -3350,6 +3490,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr, tree offset, cst_offset; tree tmp; tree stride; + tree decl = NULL_TREE; gfc_se indexse; gfc_se tmpse; gfc_symbol * sym = expr->symtree->n.sym; @@ -3494,8 +3635,31 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr, offset = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, offset, cst_offset); - se->expr = build_array_ref (se->expr, offset, sym->ts.type == BT_CLASS ? - NULL_TREE : sym->backend_decl, se->class_vptr); + /* A pointer array component can be detected from its field decl. Fix + the descriptor, mark the resulting variable decl and pass it to + build_array_ref. */ + if (!expr->ts.deferred && !sym->attr.codimension + && is_pointer_array (se->expr)) + { + if (TREE_CODE (se->expr) == COMPONENT_REF) + { + decl = gfc_evaluate_now (se->expr, &se->pre); + GFC_DECL_PTR_ARRAY_P (decl) = 1; + TREE_USED (decl) = 1; + } + else if (TREE_CODE (se->expr) == INDIRECT_REF) + decl = TREE_OPERAND (se->expr, 0); + else + decl = se->expr; + } + else if (expr->ts.deferred + || (sym->ts.type == BT_CHARACTER + && sym->attr.select_type_temporary)) + decl = sym->backend_decl; + else if (sym->ts.type == BT_CLASS) + decl = NULL_TREE; + + se->expr = build_array_ref (se->expr, offset, decl, se->class_vptr); } @@ -5651,6 +5815,19 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, if (dimension) gfc_conv_descriptor_offset_set (&set_descriptor_block, se->expr, offset); + /* Pointer arrays need the span field to be set. */ + if (is_pointer_array (se->expr) + || (expr->ts.type == BT_CLASS + && CLASS_DATA (expr)->attr.class_pointer)) + { + if (expr3 && expr3_elem_size != NULL_TREE) + tmp = expr3_elem_size; + else + tmp = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (se->expr))); + tmp = fold_convert (gfc_array_index_type, tmp); + gfc_conv_descriptor_span_set (&set_descriptor_block, se->expr, tmp); + } + set_descriptor = gfc_finish_block (&set_descriptor_block); if (status != NULL_TREE) { @@ -6854,6 +7031,10 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) /* Add any offsets from subreferences. */ gfc_get_dataptr_offset (&se->pre, se->expr, desc, NULL_TREE, subref_array_target, expr); + + /* ....and set the span field. */ + tmp = get_array_span (desc, expr); + gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp); } else if (se->want_pointer) { @@ -6889,8 +7070,18 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) se->ss = ss; else gcc_assert (se->ss == ss); + + if (!is_pointer_array (se->expr)) + { + tmp = gfc_get_element_type (TREE_TYPE (se->expr)); + tmp = fold_convert (gfc_array_index_type, + size_in_bytes (tmp)); + gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp); + } + se->expr = gfc_build_addr_expr (NULL_TREE, se->expr); gfc_conv_expr (se, expr); + gfc_free_ss_chain (ss); return; } @@ -7110,9 +7301,13 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) desc = info->descriptor; if (se->direct_byref && !se->byref_noassign) { - /* For pointer assignments we fill in the destination. */ + /* For pointer assignments we fill in the destination.... */ parm = se->expr; parmtype = TREE_TYPE (parm); + + /* ....and set the span field. */ + tmp = get_array_span (desc, expr); + gfc_conv_descriptor_span_set (&loop.pre, parm, tmp); } else { @@ -7585,6 +7780,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, /* Every other type of array. */ se->want_pointer = 1; gfc_conv_expr_descriptor (se, expr); + if (size) array_parameter_size (build_fold_indirect_ref_loc (input_location, se->expr), diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 3cc08b3..e2a8737 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -156,9 +156,13 @@ tree gfc_conv_array_ubound (tree, int); void gfc_trans_array_cobounds (tree, stmtblock_t *, const gfc_symbol *); /* Build expressions for accessing components of an array descriptor. */ +void gfc_get_descriptor_offsets_for_info (const_tree, tree *, tree *, tree *, tree *, + tree *, tree *, tree *); + tree gfc_conv_descriptor_data_get (tree); tree gfc_conv_descriptor_data_addr (tree); tree gfc_conv_descriptor_offset_get (tree); +tree gfc_conv_descriptor_span_get (tree); tree gfc_conv_descriptor_dtype (tree); tree gfc_conv_descriptor_rank (tree); tree gfc_get_descriptor_dimension (tree); @@ -169,6 +173,7 @@ tree gfc_conv_descriptor_token (tree); void gfc_conv_descriptor_data_set (stmtblock_t *, tree, tree); void gfc_conv_descriptor_offset_set (stmtblock_t *, tree, tree); +void gfc_conv_descriptor_span_set (stmtblock_t *, tree, tree); void gfc_conv_descriptor_stride_set (stmtblock_t *, tree, tree, tree); void gfc_conv_descriptor_lbound_set (stmtblock_t *, tree, tree, tree); void gfc_conv_descriptor_ubound_set (stmtblock_t *, tree, tree, tree); diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 30477c2..830c53a 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1532,6 +1532,9 @@ gfc_get_symbol_decl (gfc_symbol * sym) /* Dummy variables should already have been created. */ gcc_assert (sym->backend_decl); + if (sym->attr.pointer && sym->attr.dimension && sym->ts.type != BT_CLASS) + GFC_DECL_PTR_ARRAY_P (sym->backend_decl) = 1; + /* Create a character length variable. */ if (sym->ts.type == BT_CHARACTER) { @@ -1766,27 +1769,18 @@ gfc_get_symbol_decl (gfc_symbol * sym) if (sym->ts.type == BT_CHARACTER) /* Character variables need special handling. */ gfc_allocate_lang_decl (decl); - else if (sym->attr.subref_array_pointer) - /* We need the span for these beasts. */ - gfc_allocate_lang_decl (decl); - if (sym->attr.subref_array_pointer) - { - tree span; - GFC_DECL_SUBREF_ARRAY_P (decl) = 1; - span = build_decl (input_location, - VAR_DECL, create_tmp_var_name ("span"), - gfc_array_index_type); - gfc_finish_var_decl (span, sym); - TREE_STATIC (span) = TREE_STATIC (decl); - DECL_ARTIFICIAL (span) = 1; + if (sym->assoc && sym->attr.subref_array_pointer) + sym->attr.pointer = 1; - GFC_DECL_SPAN (decl) = span; - GFC_TYPE_ARRAY_SPAN (TREE_TYPE (decl)) = span; - } + if (sym->attr.pointer && sym->attr.dimension + && !sym->ts.deferred + && !(sym->attr.select_type_temporary + && !sym->attr.subref_array_pointer)) + GFC_DECL_PTR_ARRAY_P (decl) = 1; if (sym->ts.type == BT_CLASS) - GFC_DECL_CLASS(decl) = 1; + GFC_DECL_CLASS(decl) = 1; sym->backend_decl = decl; @@ -4347,13 +4341,15 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) } } - if (sym->attr.subref_array_pointer - && GFC_DECL_SPAN (sym->backend_decl) - && !TREE_STATIC (GFC_DECL_SPAN (sym->backend_decl))) + if (sym->attr.pointer && sym->attr.dimension + && !sym->attr.use_assoc + && !sym->attr.host_assoc + && !sym->attr.dummy + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (sym->backend_decl))) { gfc_init_block (&tmpblock); - gfc_add_modify (&tmpblock, GFC_DECL_SPAN (sym->backend_decl), - build_int_cst (gfc_array_index_type, 0)); + gfc_conv_descriptor_span_set (&tmpblock, sym->backend_decl, + build_int_cst (gfc_array_index_type, 0)); gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), NULL_TREE); } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index b310458..8c8569f 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5413,7 +5413,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, } if (e->expr_type == EXPR_VARIABLE - && is_subref_array (e)) + && is_subref_array (e) + && !(fsym && fsym->attr.pointer)) /* The actual argument is a component reference to an array of derived types. In this case, the argument is converted to a temporary, which is passed and then @@ -8223,7 +8224,6 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) stmtblock_t block; tree desc; tree tmp; - tree decl; bool scalar, non_proc_pointer_assign; gfc_ss *ss; @@ -8412,30 +8412,24 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) gfc_conv_expr_descriptor (&lse, expr2); strlen_rhs = lse.string_length; - /* If this is a subreference array pointer assignment, use the rhs - descriptor element size for the lhs span. */ - if (expr1->symtree->n.sym->attr.subref_array_pointer) - { - decl = expr1->symtree->n.sym->backend_decl; - gfc_init_se (&rse, NULL); - rse.descriptor_only = 1; - gfc_conv_expr (&rse, expr2); - if (expr1->ts.type == BT_CLASS) - trans_class_vptr_len_assignment (&block, expr1, expr2, &rse, - NULL, NULL); - tmp = gfc_get_element_type (TREE_TYPE (rse.expr)); - tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp)); - if (!INTEGER_CST_P (tmp)) - gfc_add_block_to_block (&lse.post, &rse.pre); - gfc_add_modify (&lse.post, GFC_DECL_SPAN(decl), tmp); - } - else if (expr1->ts.type == BT_CLASS) + if (expr1->ts.type == BT_CLASS) { rse.expr = NULL_TREE; rse.string_length = NULL_TREE; trans_class_vptr_len_assignment (&block, expr1, expr2, &rse, NULL, NULL); } + + if (remap == NULL) + { + /* If the target is not a whole array, use the target array + reference for remap. */ + for (remap = expr2->ref; remap; remap = remap->next) + if (remap->type == REF_ARRAY + && remap->u.ar.type == AR_FULL + && remap->next) + break; + } } else if (expr2->expr_type == EXPR_FUNCTION && expr2->ts.type == BT_CLASS) { @@ -8446,7 +8440,12 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) { rse.expr = gfc_class_data_get (rse.expr); gfc_add_modify (&lse.pre, desc, rse.expr); - } + /* Set the lhs span. */ + tmp = TREE_TYPE (rse.expr); + tmp = TYPE_SIZE_UNIT (gfc_get_element_type (tmp)); + tmp = fold_convert (gfc_array_index_type, tmp); + gfc_conv_descriptor_span_set (&lse.pre, desc, tmp); + } else { expr1_vptr = trans_class_vptr_len_assignment (&block, expr1, @@ -8492,7 +8491,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) converted in rse and now have to build the correct LHS descriptor for it. */ - tree dtype, data; + tree dtype, data, span; tree offs, stride; tree lbound, ubound; @@ -8505,6 +8504,18 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) data = gfc_conv_descriptor_data_get (rse.expr); gfc_conv_descriptor_data_set (&block, desc, data); + /* Copy the span. */ + if (TREE_CODE (rse.expr) == VAR_DECL + && GFC_DECL_PTR_ARRAY_P (rse.expr)) + span = gfc_conv_descriptor_span_get (rse.expr); + else + { + tmp = TREE_TYPE (rse.expr); + tmp = TYPE_SIZE_UNIT (gfc_get_element_type (tmp)); + span = fold_convert (gfc_array_index_type, tmp); + } + gfc_conv_descriptor_span_set (&block, desc, span); + /* Copy offset but adjust it such that it would correspond to a lbound of zero. */ offs = gfc_conv_descriptor_offset_get (rse.expr); @@ -8586,12 +8597,18 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) { gfc_se lbound_se; - gcc_assert (remap->u.ar.start[dim]); gcc_assert (!remap->u.ar.end[dim]); gfc_init_se (&lbound_se, NULL); - gfc_conv_expr (&lbound_se, remap->u.ar.start[dim]); - - gfc_add_block_to_block (&block, &lbound_se.pre); + if (remap->u.ar.start[dim]) + { + gfc_conv_expr (&lbound_se, remap->u.ar.start[dim]); + gfc_add_block_to_block (&block, &lbound_se.pre); + } + else + /* This remap arises from a target that is not a whole + array. The start expressions will be NULL but we need + the lbounds to be one. */ + lbound_se.expr = gfc_index_one_node; gfc_conv_shift_descriptor_lbound (&block, desc, dim, lbound_se.expr); gfc_add_block_to_block (&block, &lbound_se.post); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 3c9e1d5..9bc465e 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -1225,10 +1225,9 @@ conv_expr_ref_to_caf_ref (stmtblock_t *block, gfc_expr *expr) && ref->u.c.component->attr.dimension) { tree arr_desc_token_offset; - /* Get the token from the descriptor. */ - arr_desc_token_offset = gfc_advance_chain ( - TYPE_FIELDS (TREE_TYPE (ref->u.c.component->backend_decl)), - 4 /* CAF_TOKEN_FIELD */); + /* Get the token field from the descriptor. */ + arr_desc_token_offset = TREE_OPERAND ( + gfc_conv_descriptor_token (ref->u.c.component->backend_decl), 1); arr_desc_token_offset = compute_component_offset (arr_desc_token_offset, TREE_TYPE (tmp)); @@ -8129,6 +8128,11 @@ conv_isocbinding_subroutine (gfc_code *code) gfc_add_block_to_block (&block, &fptrse.pre); desc = fptrse.expr; + /* Set the span field. */ + tmp = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc))); + tmp = fold_convert (gfc_array_index_type, tmp); + gfc_conv_descriptor_span_set (&block, desc, tmp); + /* Set data value, dtype, and offset. */ tmp = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc)); gfc_conv_descriptor_data_set (&block, desc, fold_convert (tmp, cptrse.expr)); diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index aa974eb..026f9a9 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -2569,6 +2569,12 @@ gfc_trans_transfer (gfc_code * code) gcc_assert (ref && ref->type == REF_ARRAY); } + if (expr->ts.type != BT_CLASS + && expr->expr_type == EXPR_VARIABLE + && gfc_expr_attr (expr).pointer) + goto scalarize; + + if (!(gfc_bt_struct (expr->ts.type) || expr->ts.type == BT_CLASS) && ref && ref->next == NULL @@ -2603,6 +2609,7 @@ gfc_trans_transfer (gfc_code * code) goto finish_block_label; } +scalarize: /* Initialize the scalarizer. */ ss = gfc_walk_expr (expr); gfc_init_loopinfo (&loop); @@ -2618,7 +2625,9 @@ gfc_trans_transfer (gfc_code * code) gfc_copy_loopinfo_to_se (&se, &loop); se.ss = ss; + gfc_conv_expr_reference (&se, expr); + if (expr->ts.type == BT_CLASS) vptr = gfc_get_vptr_from_expr (ss->info->data.array.descriptor); else diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 6a407f9..925ea63 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1531,6 +1531,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) int n; tree charlen; bool need_len_assign; + bool whole_array = true; + gfc_ref *ref; gcc_assert (sym->assoc); e = sym->assoc->target; @@ -1541,6 +1543,15 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) unlimited = UNLIMITED_POLY (e); + for (ref = e->ref; ref; ref = ref->next) + if (ref->type == REF_ARRAY + && ref->u.ar.type == AR_FULL + && ref->next) + { + whole_array = false; + break; + } + /* Assignments to the string length need to be generated, when ( sym is a char array or sym has a _len component) @@ -1583,11 +1594,13 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) /* If we didn't already do the pointer assignment, set associate-name descriptor to the one generated for the temporary. */ - if (!sym->assoc->variable && !cst_array_ctor) + if ((!sym->assoc->variable && !cst_array_ctor) + || !whole_array) { int dim; - gfc_add_modify (&se.pre, desc, se.expr); + if (whole_array) + gfc_add_modify (&se.pre, desc, se.expr); /* The generated descriptor has lower bound zero (as array temporary), shift bounds so we get lower bounds of 1. */ @@ -1606,7 +1619,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) : e->symtree->n.sym->backend_decl; tmp = gfc_get_element_type (TREE_TYPE (tmp)); tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp)); - gfc_add_modify (&se.pre, GFC_DECL_SPAN(desc), tmp); + gfc_conv_descriptor_span_set (&se.pre, desc, tmp); } /* Done, register stuff as init / cleanup code. */ diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 061222f..b106794 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -35,6 +35,7 @@ along with GCC; see the file COPYING3. If not see #include "toplev.h" /* For rest_of_decl_compilation. */ #include "trans-types.h" #include "trans-const.h" +#include "trans-array.h" #include "dwarf2out.h" /* For struct array_descr_info. */ #include "attribs.h" @@ -1786,6 +1787,12 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted) gfc_array_index_type, &chain); TREE_NO_WARNING (decl) = 1; + /* Add the span component. */ + decl = gfc_add_field_to_struct_1 (fat_type, + get_identifier ("span"), + gfc_array_index_type, &chain); + TREE_NO_WARNING (decl) = 1; + /* Build the array type for the stride and bound components. */ if (dimen + codimen > 0) { @@ -2715,6 +2722,11 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen) if (!c->backend_decl) c->backend_decl = field; + if (c->attr.pointer && c->attr.dimension + && !(c->ts.type == BT_DERIVED + && strcmp (c->name, "_data") == 0)) + GFC_DECL_PTR_ARRAY_P (c->backend_decl) = 1; + /* Do not add a caf_token field for classes' data components. */ if (codimen && !c->attr.dimension && !c->attr.codimension && (c->attr.allocatable || c->attr.pointer) @@ -3154,7 +3166,7 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info) { int rank, dim; bool indirect = false; - tree etype, ptype, field, t, base_decl; + tree etype, ptype, t, base_decl; tree data_off, dim_off, dtype_off, dim_size, elem_size; tree lower_suboff, upper_suboff, stride_suboff; @@ -3211,24 +3223,11 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info) if (indirect) base_decl = build1 (INDIRECT_REF, ptype, base_decl); - if (GFC_TYPE_ARRAY_SPAN (type)) - elem_size = GFC_TYPE_ARRAY_SPAN (type); - else - elem_size = fold_convert (gfc_array_index_type, TYPE_SIZE_UNIT (etype)); - field = TYPE_FIELDS (TYPE_MAIN_VARIANT (type)); - data_off = byte_position (field); - field = DECL_CHAIN (field); - field = DECL_CHAIN (field); - dtype_off = byte_position (field); - field = DECL_CHAIN (field); - dim_off = byte_position (field); - dim_size = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (field))); - field = TYPE_FIELDS (TREE_TYPE (TREE_TYPE (field))); - stride_suboff = byte_position (field); - field = DECL_CHAIN (field); - lower_suboff = byte_position (field); - field = DECL_CHAIN (field); - upper_suboff = byte_position (field); + elem_size = fold_convert (gfc_array_index_type, TYPE_SIZE_UNIT (etype)); + + gfc_get_descriptor_offsets_for_info (type, &data_off, &dtype_off, &dim_off, + &dim_size, &stride_suboff, + &lower_suboff, &upper_suboff); t = base_decl; if (!integer_zerop (data_off)) diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index cb6a57f..149f482 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -305,6 +305,67 @@ gfc_build_addr_expr (tree type, tree t) } +static tree +get_array_span (tree type, tree decl) +{ + tree span; + + /* Return the span for deferred character length array references. */ + if (type && TREE_CODE (type) == ARRAY_TYPE + && TYPE_MAX_VALUE (TYPE_DOMAIN (type)) != NULL_TREE + && (VAR_P (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) + || TREE_CODE (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) == INDIRECT_REF) + && (TREE_CODE (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) == INDIRECT_REF + || TREE_CODE (decl) == FUNCTION_DECL + || DECL_CONTEXT (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) + == DECL_CONTEXT (decl))) + { + span = TYPE_MAX_VALUE (TYPE_DOMAIN (type)); + span = fold_convert (gfc_array_index_type, span); + } + /* Likewise for class array or pointer array references. */ + else if (TREE_CODE (decl) == FIELD_DECL + || VAR_OR_FUNCTION_DECL_P (decl) + || TREE_CODE (decl) == PARM_DECL) + { + if (GFC_DECL_CLASS (decl)) + { + /* When a temporary is in place for the class array, then the + original class' declaration is stored in the saved + descriptor. */ + if (DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl)) + decl = GFC_DECL_SAVED_DESCRIPTOR (decl); + else + { + /* Allow for dummy arguments and other good things. */ + if (POINTER_TYPE_P (TREE_TYPE (decl))) + decl = build_fold_indirect_ref_loc (input_location, decl); + + /* Check if '_data' is an array descriptor. If it is not, + the array must be one of the components of the class + object, so return a null span. */ + if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE ( + gfc_class_data_get (decl)))) + return NULL_TREE; + } + span = gfc_class_vtab_size_get (decl); + } + else if (GFC_DECL_PTR_ARRAY_P (decl)) + { + if (TREE_CODE (decl) == PARM_DECL) + decl = build_fold_indirect_ref_loc (input_location, decl); + span = gfc_conv_descriptor_span_get (decl); + } + else + span = NULL_TREE; + } + else + span = NULL_TREE; + + return span; +} + + /* Build an ARRAY_REF with its natural type. */ tree @@ -312,7 +373,7 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr) { tree type = TREE_TYPE (base); tree tmp; - tree span; + tree span = NULL_TREE; if (GFC_ARRAY_TYPE_P (type) && GFC_TYPE_ARRAY_RANK (type) == 0) { @@ -331,77 +392,23 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr) type = TREE_TYPE (type); - /* Use pointer arithmetic for deferred character length array - references. */ - if (type && TREE_CODE (type) == ARRAY_TYPE - && TYPE_MAX_VALUE (TYPE_DOMAIN (type)) != NULL_TREE - && (VAR_P (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) - || TREE_CODE (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) == INDIRECT_REF) - && decl - && (TREE_CODE (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) == INDIRECT_REF - || TREE_CODE (decl) == FUNCTION_DECL - || (DECL_CONTEXT (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) - == DECL_CONTEXT (decl)))) - span = TYPE_MAX_VALUE (TYPE_DOMAIN (type)); - else - span = NULL_TREE; - if (DECL_P (base)) TREE_ADDRESSABLE (base) = 1; /* Strip NON_LVALUE_EXPR nodes. */ STRIP_TYPE_NOPS (offset); - /* If the array reference is to a pointer, whose target contains a - subreference, use the span that is stored with the backend decl - and reference the element with pointer arithmetic. */ - if ((decl && (TREE_CODE (decl) == FIELD_DECL - || VAR_OR_FUNCTION_DECL_P (decl) - || TREE_CODE (decl) == PARM_DECL) - && ((GFC_DECL_SUBREF_ARRAY_P (decl) - && !integer_zerop (GFC_DECL_SPAN (decl))) - || GFC_DECL_CLASS (decl) - || span != NULL_TREE)) - || vptr != NULL_TREE) - { - if (decl) - { - if (GFC_DECL_CLASS (decl)) - { - /* When a temporary is in place for the class array, then the - original class' declaration is stored in the saved - descriptor. */ - if (DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl)) - decl = GFC_DECL_SAVED_DESCRIPTOR (decl); - else - { - /* Allow for dummy arguments and other good things. */ - if (POINTER_TYPE_P (TREE_TYPE (decl))) - decl = build_fold_indirect_ref_loc (input_location, decl); - - /* Check if '_data' is an array descriptor. If it is not, - the array must be one of the components of the class - object, so return a normal array reference. */ - if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE ( - gfc_class_data_get (decl)))) - return build4_loc (input_location, ARRAY_REF, type, base, - offset, NULL_TREE, NULL_TREE); - } - - span = gfc_class_vtab_size_get (decl); - } - else if (GFC_DECL_SUBREF_ARRAY_P (decl)) - span = GFC_DECL_SPAN (decl); - else if (span) - span = fold_convert (gfc_array_index_type, span); - else - gcc_unreachable (); - } - else if (vptr) - span = gfc_vptr_size_get (vptr); - else - gcc_unreachable (); + /* If decl or vptr are non-null, pointer arithmetic for the array reference + is likely. Generate the 'span' for the array reference. */ + if (vptr) + span = gfc_vptr_size_get (vptr); + else if (decl) + span = get_array_span (type, decl); + /* If a non-null span has been generated reference the element with + pointer arithmetic. */ + if (span != NULL_TREE) + { offset = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, offset, span); @@ -412,8 +419,8 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr) tmp = build_fold_indirect_ref_loc (input_location, tmp); return tmp; } + /* Otherwise use a straightforward array reference. */ else - /* Otherwise use a straightforward array reference. */ return build4_loc (input_location, ARRAY_REF, type, base, offset, NULL_TREE, NULL_TREE); } diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index d02f347..c970ace 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -982,7 +982,7 @@ struct GTY(()) lang_decl { #define GFC_DECL_COMMON_OR_EQUIV(node) DECL_LANG_FLAG_3(node) #define GFC_DECL_CRAY_POINTEE(node) DECL_LANG_FLAG_4(node) #define GFC_DECL_RESULT(node) DECL_LANG_FLAG_5(node) -#define GFC_DECL_SUBREF_ARRAY_P(node) DECL_LANG_FLAG_6(node) +#define GFC_DECL_PTR_ARRAY_P(node) DECL_LANG_FLAG_6(node) #define GFC_DECL_ASSOCIATE_VAR_P(node) DECL_LANG_FLAG_7(node) #define GFC_DECL_CLASS(node) DECL_LANG_FLAG_8(node) |