diff options
Diffstat (limited to 'gcc/fortran/trans-array.c')
-rw-r--r-- | gcc/fortran/trans-array.c | 29 |
1 files changed, 27 insertions, 2 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index cc8e97e..1edc7b7 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3255,7 +3255,7 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset, if (dim + 1 < as->rank) stride = GFC_TYPE_ARRAY_STRIDE (type, dim + 1); else - stride = NULL_TREE; + stride = GFC_TYPE_ARRAY_SIZE (type); if (ubound != NULL_TREE && !(stride && INTEGER_CST_P (stride))) { @@ -3273,6 +3273,8 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset, size = stride; } + gfc_trans_vla_type_sizes (sym, pblock); + *poffset = offset; return size; } @@ -3309,6 +3311,8 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody) { gfc_trans_init_string_length (sym->ts.cl, &block); + gfc_trans_vla_type_sizes (sym, &block); + /* Emit a DECL_EXPR for this variable, which will cause the gimplifier to allocate storage, and all that good stuff. */ tmp = build1 (DECL_EXPR, TREE_TYPE (decl), decl); @@ -3661,12 +3665,30 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body) gfc_add_modify_expr (&block, stride, tmp); } } + else + { + stride = GFC_TYPE_ARRAY_SIZE (type); + + if (stride && !INTEGER_CST_P (stride)) + { + /* Calculate size = stride * (ubound + 1 - lbound). */ + tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, + gfc_index_one_node, lbound); + tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, + ubound, tmp); + tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, + GFC_TYPE_ARRAY_STRIDE (type, n), tmp); + gfc_add_modify_expr (&block, stride, tmp); + } + } } /* Set the offset. */ if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL) gfc_add_modify_expr (&block, GFC_TYPE_ARRAY_OFFSET (type), offset); + gfc_trans_vla_type_sizes (sym, &block); + stmt = gfc_finish_block (&block); gfc_start_block (&block); @@ -4268,7 +4290,10 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body) if (sym->ts.type == BT_CHARACTER && !INTEGER_CST_P (sym->ts.cl->backend_decl)) - gfc_trans_init_string_length (sym->ts.cl, &fnblock); + { + gfc_trans_init_string_length (sym->ts.cl, &fnblock); + gfc_trans_vla_type_sizes (sym, &fnblock); + } /* Dummy and use associated variables don't need anything special. */ if (sym->attr.dummy || sym->attr.use_assoc) |