https://gcc.gnu.org/g:58fd64f762b8277085dbefb6d2c58a9c39f3d88d
commit 58fd64f762b8277085dbefb6d2c58a9c39f3d88d Author: Mikael Morin <[email protected]> Date: Mon Oct 6 15:54:11 2025 +0200 Correction régression finalize_17.f90 Diff: --- gcc/fortran/class.cc | 65 ++++++++++++++++++++++++++++------------------------ 1 file changed, 35 insertions(+), 30 deletions(-) diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc index 6e0704c9e502..a1c6fafa75ef 100644 --- a/gcc/fortran/class.cc +++ b/gcc/fortran/class.cc @@ -1320,11 +1320,13 @@ finalization_scalarizer (gfc_symbol *array, gfc_symbol *ptr, offset = 0 do idx2 = 1, rank offset = offset + mod (idx, sizes(idx2)) / sizes(idx2-1) * strides(idx2) - end do. */ + end do + offset = offset * byte_stride. */ static gfc_code* finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset, - gfc_symbol *strides, gfc_symbol *sizes, gfc_expr *rank, + gfc_symbol *strides, gfc_symbol *sizes, + gfc_symbol *byte_stride, gfc_expr *rank, gfc_code *block, gfc_namespace *sub_ns) { gfc_iterator *iter; @@ -1418,6 +1420,17 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset, block->block->next->expr2->ts = idx->ts; block->block->next->expr2->where = gfc_current_locus; + /* After the loop: offset = offset * byte_stride. */ + block->next = gfc_get_code (EXEC_ASSIGN); + block = block->next; + block->expr1 = gfc_lval_expr_from_sym (offset); + block->expr2 = gfc_get_expr (); + block->expr2->expr_type = EXPR_OP; + block->expr2->value.op.op = INTRINSIC_TIMES; + block->expr2->value.op.op1 = gfc_lval_expr_from_sym (offset); + block->expr2->value.op.op2 = gfc_lval_expr_from_sym (byte_stride); + block->expr2->ts = block->expr2->value.op.op1->ts; + block->expr2->where = gfc_current_locus; return block; } @@ -1633,7 +1646,7 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini, /* Offset calculation of "array". */ block2 = finalization_get_offset (idx, idx2, offset, strides, sizes, - rank, block->block, sub_ns); + byte_stride, rank, block->block, sub_ns); /* Create code for CALL C_F_POINTER (TRANSFER (TRANSFER (C_LOC (array, cptr), c_intptr) @@ -1678,7 +1691,7 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini, /* Offset calculation of "array". */ block2 = finalization_get_offset (idx, idx2, offset, strides, sizes, - rank, block->block, sub_ns); + byte_stride, rank, block->block, sub_ns); /* Create code for CALL C_F_POINTER (TRANSFER (TRANSFER (C_LOC (array, cptr), c_intptr) @@ -2064,7 +2077,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, block->block = gfc_get_code (EXEC_IF); block = block->block; - /* if condition: strides(idx) /= sizes(idx-1) * byte_stride. */ + /* if condition: strides(idx) /= sizes(idx-1). */ block->expr1 = gfc_get_expr (); block->expr1->ts.type = BT_LOGICAL; block->expr1->ts.kind = gfc_default_logical_kind; @@ -2081,30 +2094,23 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, block->expr1->value.op.op1->ref->u.ar.start[0] = gfc_lval_expr_from_sym (idx); block->expr1->value.op.op1->ref->u.ar.as = strides->as; - block->expr1->value.op.op2 = gfc_get_expr (); - block->expr1->value.op.op2->ts.type = BT_INTEGER; - block->expr1->value.op.op2->ts.kind = gfc_index_integer_kind; - block->expr1->value.op.op2->expr_type = EXPR_OP; - block->expr1->value.op.op2->where = gfc_current_locus; - block->expr1->value.op.op2->value.op.op = INTRINSIC_TIMES; - block->expr1->value.op.op2->value.op.op1 = gfc_lval_expr_from_sym (sizes); - block->expr1->value.op.op2->value.op.op1->ref = gfc_get_ref (); - block->expr1->value.op.op2->value.op.op1->ref->type = REF_ARRAY; - block->expr1->value.op.op2->value.op.op1->ref->u.ar.as = sizes->as; - block->expr1->value.op.op2->value.op.op1->ref->u.ar.type = AR_ELEMENT; - block->expr1->value.op.op2->value.op.op1->ref->u.ar.dimen = 1; - block->expr1->value.op.op2->value.op.op1->ref->u.ar.dimen_type[0] = DIMEN_ELEMENT; - block->expr1->value.op.op2->value.op.op1->ref->u.ar.start[0] = gfc_get_expr (); - block->expr1->value.op.op2->value.op.op1->ref->u.ar.start[0]->expr_type = EXPR_OP; - block->expr1->value.op.op2->value.op.op1->ref->u.ar.start[0]->where = gfc_current_locus; - block->expr1->value.op.op2->value.op.op1->ref->u.ar.start[0]->value.op.op = INTRINSIC_MINUS; - block->expr1->value.op.op2->value.op.op1->ref->u.ar.start[0]->value.op.op1 + block->expr1->value.op.op2 = gfc_lval_expr_from_sym (sizes); + block->expr1->value.op.op2->ref = gfc_get_ref (); + block->expr1->value.op.op2->ref->type = REF_ARRAY; + block->expr1->value.op.op2->ref->u.ar.as = sizes->as; + block->expr1->value.op.op2->ref->u.ar.type = AR_ELEMENT; + block->expr1->value.op.op2->ref->u.ar.dimen = 1; + block->expr1->value.op.op2->ref->u.ar.dimen_type[0] = DIMEN_ELEMENT; + block->expr1->value.op.op2->ref->u.ar.start[0] = gfc_get_expr (); + block->expr1->value.op.op2->ref->u.ar.start[0]->expr_type = EXPR_OP; + block->expr1->value.op.op2->ref->u.ar.start[0]->where = gfc_current_locus; + block->expr1->value.op.op2->ref->u.ar.start[0]->value.op.op = INTRINSIC_MINUS; + block->expr1->value.op.op2->ref->u.ar.start[0]->value.op.op1 = gfc_lval_expr_from_sym (idx); - block->expr1->value.op.op2->value.op.op1->ref->u.ar.start[0]->value.op.op2 + block->expr1->value.op.op2->ref->u.ar.start[0]->value.op.op2 = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1); - block->expr1->value.op.op2->value.op.op1->ref->u.ar.start[0]->ts - = block->expr1->value.op.op2->value.op.op1->ref->u.ar.start[0]->value.op.op1->ts; - block->expr1->value.op.op2->value.op.op2 = gfc_lval_expr_from_sym (byte_stride); + block->expr1->value.op.op2->ref->u.ar.start[0]->ts + = block->expr1->value.op.op2->ref->u.ar.start[0]->value.op.op1->ts; /* if body: is_contiguous = .false. */ block->next = gfc_get_code (EXEC_ASSIGN); @@ -2279,7 +2285,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, /* Offset calculation. */ block = finalization_get_offset (idx, idx2, offset, strides, sizes, - rank, block->block, + byte_stride, rank, block->block, sub_ns); /* Create code for @@ -2345,7 +2351,7 @@ finish_assumed_rank: /* Offset calculation. */ block = finalization_get_offset (idx, idx2, offset, strides, sizes, - rank, last_code->block, + byte_stride, rank, last_code->block, sub_ns); /* Create code for @@ -2725,7 +2731,6 @@ gfc_find_derived_vtab (gfc_symbol *derived) arg->attr.intent = INTENT_INOUT; arg->attr.dimension = 1; arg->attr.allocatable = 1; - arg->attr.contiguous = 1; arg->as = gfc_get_array_spec(); arg->as->type = AS_ASSUMED_SHAPE; arg->as->rank = 1;
