diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.cc | 57 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.cc | 6 |
3 files changed, 18 insertions, 54 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 12002d9..69755e2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2022-11-07 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/107508 + * trans-array.cc (gfc_alloc_allocatable_for_assignment): Fix + string-length check, plug memory leak, and avoid generation of + effectively no-op code. + * trans-expr.cc (alloc_scalar_allocatable_for_assignment): Extend + comment; minor cleanup. + 2022-11-03 Tobias Burnus <tobias@codesourcery.com> * openmp.cc (gfc_match_omp_clauses): Permit derived types for diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 514cb05..b7d4c41 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -10527,7 +10527,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, tree offset; tree jump_label1; tree jump_label2; - tree neq_size; tree lbd; tree class_expr2 = NULL_TREE; int n; @@ -10607,6 +10606,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, elemsize1 = expr1->ts.u.cl->backend_decl; else elemsize1 = lss->info->string_length; + tree unit_size = TYPE_SIZE_UNIT (gfc_get_char_type (expr1->ts.kind)); + elemsize1 = fold_build2_loc (input_location, MULT_EXPR, + TREE_TYPE (elemsize1), elemsize1, + fold_convert (TREE_TYPE (elemsize1), unit_size)); + } else if (expr1->ts.type == BT_CLASS) { @@ -10699,19 +10703,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, /* Allocate if data is NULL. */ cond_null = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, array1, build_int_cst (TREE_TYPE (array1), 0)); - - if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred) - { - tmp = fold_build2_loc (input_location, NE_EXPR, - logical_type_node, - lss->info->string_length, - rss->info->string_length); - cond_null = fold_build2_loc (input_location, TRUTH_OR_EXPR, - logical_type_node, tmp, cond_null); - cond_null= gfc_evaluate_now (cond_null, &fblock); - } - else - cond_null= gfc_evaluate_now (cond_null, &fblock); + cond_null= gfc_evaluate_now (cond_null, &fblock); tmp = build3_v (COND_EXPR, cond_null, build1_v (GOTO_EXPR, jump_label1), @@ -10778,19 +10770,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, tmp = build1_v (LABEL_EXPR, jump_label1); gfc_add_expr_to_block (&fblock, tmp); - /* If the lhs has not been allocated, its bounds will not have been - initialized and so its size is set to zero. */ - size1 = gfc_create_var (gfc_array_index_type, NULL); - gfc_init_block (&alloc_block); - gfc_add_modify (&alloc_block, size1, gfc_index_zero_node); - gfc_init_block (&realloc_block); - gfc_add_modify (&realloc_block, size1, - gfc_conv_descriptor_size (desc, expr1->rank)); - tmp = build3_v (COND_EXPR, cond_null, - gfc_finish_block (&alloc_block), - gfc_finish_block (&realloc_block)); - gfc_add_expr_to_block (&fblock, tmp); - /* Get the rhs size and fix it. */ size2 = gfc_index_one_node; for (n = 0; n < expr2->rank; n++) @@ -10807,16 +10786,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, } size2 = gfc_evaluate_now (size2, &fblock); - cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, - size1, size2); - - /* If the lhs is deferred length, assume that the element size - changes and force a reallocation. */ - if (expr1->ts.deferred) - neq_size = gfc_evaluate_now (logical_true_node, &fblock); - else - neq_size = gfc_evaluate_now (cond, &fblock); - /* Deallocation of allocatable components will have to occur on reallocation. Fix the old descriptor now. */ if ((expr1->ts.type == BT_DERIVED) @@ -11048,20 +11017,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, gfc_add_block_to_block (&realloc_block, &caf_se.post); realloc_expr = gfc_finish_block (&realloc_block); - /* Reallocate if sizes or dynamic types are different. */ - if (elemsize1) - { - tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, - elemsize1, elemsize2); - tmp = gfc_evaluate_now (tmp, &fblock); - neq_size = fold_build2_loc (input_location, TRUTH_OR_EXPR, - logical_type_node, neq_size, tmp); - } - tmp = build3_v (COND_EXPR, neq_size, realloc_expr, - build_empty_stmt (input_location)); - - realloc_expr = tmp; - /* Malloc expression. */ gfc_init_block (&alloc_block); if (!coarray) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index e7b9211..f3fbb52 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -11236,10 +11236,10 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block, if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred) { - /* Use the rhs string length and the lhs element size. */ + /* Use the rhs string length and the lhs element size. Note that 'size' is + used below for the string-length comparison, only. */ size = string_length; - tmp = TREE_TYPE (gfc_typenode_for_spec (&expr1->ts)); - tmp = TYPE_SIZE_UNIT (tmp); + tmp = TYPE_SIZE_UNIT (gfc_get_char_type (expr1->ts.kind)); size_in_bytes = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp), tmp, fold_convert (TREE_TYPE (tmp), size)); |