From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1928) id EFC9A3858030; Mon, 14 Feb 2022 15:18:17 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org EFC9A3858030 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Andre Vehreschild To: gcc-cvs@gcc.gnu.org Subject: [gcc r11-9567] Prevent malicious descriptor stacking for scalar components [V2, backport]. X-Act-Checkin: gcc X-Git-Author: Andre Vehreschild X-Git-Refname: refs/heads/releases/gcc-11 X-Git-Oldrev: 8eee43d29179f2bdfabe0959058f22eae6f5d92c X-Git-Newrev: 680ee9c333280df74e06e1bc9f3be218424f94b3 Message-Id: <20220214151817.EFC9A3858030@sourceware.org> Date: Mon, 14 Feb 2022 15:18:17 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 14 Feb 2022 15:18:18 -0000 https://gcc.gnu.org/g:680ee9c333280df74e06e1bc9f3be218424f94b3 commit r11-9567-g680ee9c333280df74e06e1bc9f3be218424f94b3 Author: Andre Vehreschild Date: Mon Feb 14 16:12:14 2022 +0100 Prevent malicious descriptor stacking for scalar components [V2, backport]. gcc/fortran/ChangeLog: PR fortran/103790 Backported from master. * trans-array.c (structure_alloc_comps): Prevent descriptor stacking for non-array data; do not broadcast caf-tokens. * trans-intrinsic.c (conv_co_collective): Prevent generation of unused descriptor. gcc/testsuite/ChangeLog: PR fortran/103790 * gfortran.dg/coarray_collectives_18.f90: New test. Diff: --- gcc/fortran/trans-array.c | 74 ++++++++++++++-------- gcc/fortran/trans-intrinsic.c | 40 ++++++------ .../gfortran.dg/coarray_collectives_18.f90 | 37 +++++++++++ 3 files changed, 108 insertions(+), 43 deletions(-) diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index dc89e97b0a1..ad6a30a47ca 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -8826,6 +8826,10 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, continue; } + /* Do not broadcast a caf_token. These are local to the image. */ + if (attr->caf_token) + continue; + add_when_allocated = NULL_TREE; if (cmp_has_alloc_comps && !c->attr.pointer && !c->attr.proc_pointer) @@ -8858,10 +8862,13 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, if (attr->dimension) { tmp = gfc_get_element_type (TREE_TYPE (comp)); - ubound = gfc_full_array_size (&tmpblock, comp, - c->ts.type == BT_CLASS - ? CLASS_DATA (c)->as->rank - : c->as->rank); + if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp))) + ubound = GFC_TYPE_ARRAY_SIZE (TREE_TYPE (comp)); + else + ubound = gfc_full_array_size (&tmpblock, comp, + c->ts.type == BT_CLASS + ? CLASS_DATA (c)->as->rank + : c->as->rank); } else { @@ -8869,26 +8876,39 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, ubound = build_int_cst (gfc_array_index_type, 1); } - cdesc = gfc_get_array_type_bounds (tmp, 1, 0, &gfc_index_one_node, - &ubound, 1, - GFC_ARRAY_ALLOCATABLE, false); + /* Treat strings like arrays. Or the other way around, do not + * generate an additional array layer for scalar components. */ + if (attr->dimension || c->ts.type == BT_CHARACTER) + { + cdesc = gfc_get_array_type_bounds (tmp, 1, 0, &gfc_index_one_node, + &ubound, 1, + GFC_ARRAY_ALLOCATABLE, false); - cdesc = gfc_create_var (cdesc, "cdesc"); - DECL_ARTIFICIAL (cdesc) = 1; + cdesc = gfc_create_var (cdesc, "cdesc"); + DECL_ARTIFICIAL (cdesc) = 1; - gfc_add_modify (&tmpblock, gfc_conv_descriptor_dtype (cdesc), - gfc_get_dtype_rank_type (1, tmp)); - gfc_conv_descriptor_lbound_set (&tmpblock, cdesc, - gfc_index_zero_node, - gfc_index_one_node); - gfc_conv_descriptor_stride_set (&tmpblock, cdesc, - gfc_index_zero_node, - gfc_index_one_node); - gfc_conv_descriptor_ubound_set (&tmpblock, cdesc, - gfc_index_zero_node, ubound); + gfc_add_modify (&tmpblock, gfc_conv_descriptor_dtype (cdesc), + gfc_get_dtype_rank_type (1, tmp)); + gfc_conv_descriptor_lbound_set (&tmpblock, cdesc, + gfc_index_zero_node, + gfc_index_one_node); + gfc_conv_descriptor_stride_set (&tmpblock, cdesc, + gfc_index_zero_node, + gfc_index_one_node); + gfc_conv_descriptor_ubound_set (&tmpblock, cdesc, + gfc_index_zero_node, ubound); + } + else + /* Prevent warning. */ + cdesc = NULL_TREE; if (attr->dimension) - comp = gfc_conv_descriptor_data_get (comp); + { + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp))) + comp = gfc_conv_descriptor_data_get (comp); + else + comp = gfc_build_addr_expr (NULL_TREE, comp); + } else { gfc_se se; @@ -8896,14 +8916,18 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, gfc_init_se (&se, NULL); comp = gfc_conv_scalar_to_descriptor (&se, comp, - c->ts.type == BT_CLASS - ? CLASS_DATA (c)->attr - : c->attr); - comp = gfc_build_addr_expr (NULL_TREE, comp); + c->ts.type == BT_CLASS + ? CLASS_DATA (c)->attr + : c->attr); + if (c->ts.type == BT_CHARACTER) + comp = gfc_build_addr_expr (NULL_TREE, comp); gfc_add_block_to_block (&tmpblock, &se.pre); } - gfc_conv_descriptor_data_set (&tmpblock, cdesc, comp); + if (attr->dimension || c->ts.type == BT_CHARACTER) + gfc_conv_descriptor_data_set (&tmpblock, cdesc, comp); + else + cdesc = comp; tree fndecl; diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 40dc983b751..eb928c6ef0a 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -11272,24 +11272,31 @@ conv_co_collective (gfc_code *code) return gfc_finish_block (&block); } + gfc_symbol *derived = code->ext.actual->expr->ts.type == BT_DERIVED + ? code->ext.actual->expr->ts.u.derived : NULL; + /* Handle the array. */ gfc_init_se (&argse, NULL); - if (code->ext.actual->expr->rank == 0) - { - symbol_attribute attr; - gfc_clear_attr (&attr); - gfc_init_se (&argse, NULL); - gfc_conv_expr (&argse, code->ext.actual->expr); - gfc_add_block_to_block (&block, &argse.pre); - gfc_add_block_to_block (&post_block, &argse.post); - array = gfc_conv_scalar_to_descriptor (&argse, argse.expr, attr); - array = gfc_build_addr_expr (NULL_TREE, array); - } - else + if (!derived || !derived->attr.alloc_comp + || code->resolved_isym->id != GFC_ISYM_CO_BROADCAST) { - argse.want_pointer = 1; - gfc_conv_expr_descriptor (&argse, code->ext.actual->expr); - array = argse.expr; + if (code->ext.actual->expr->rank == 0) + { + symbol_attribute attr; + gfc_clear_attr (&attr); + gfc_init_se (&argse, NULL); + gfc_conv_expr (&argse, code->ext.actual->expr); + gfc_add_block_to_block (&block, &argse.pre); + gfc_add_block_to_block (&post_block, &argse.post); + array = gfc_conv_scalar_to_descriptor (&argse, argse.expr, attr); + array = gfc_build_addr_expr (NULL_TREE, array); + } + else + { + argse.want_pointer = 1; + gfc_conv_expr_descriptor (&argse, code->ext.actual->expr); + array = argse.expr; + } } gfc_add_block_to_block (&block, &argse.pre); @@ -11350,9 +11357,6 @@ conv_co_collective (gfc_code *code) gcc_unreachable (); } - gfc_symbol *derived = code->ext.actual->expr->ts.type == BT_DERIVED - ? code->ext.actual->expr->ts.u.derived : NULL; - if (derived && derived->attr.alloc_comp && code->resolved_isym->id == GFC_ISYM_CO_BROADCAST) /* The derived type has the attribute 'alloc_comp'. */ diff --git a/gcc/testsuite/gfortran.dg/coarray_collectives_18.f90 b/gcc/testsuite/gfortran.dg/coarray_collectives_18.f90 new file mode 100644 index 00000000000..5636a89e94a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_collectives_18.f90 @@ -0,0 +1,37 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original -fcoarray=lib" } +! +! PR 103970 +! Test case inspired by code submitted by Damian Rousson + +program main + + implicit none + + type foo_t + integer i + integer, allocatable :: j + end type + + type(foo_t) foo + integer, parameter :: source_image = 1 + + if (this_image() == source_image) then + foo = foo_t(2,3) + else + allocate(foo%j) + end if + call co_broadcast(foo, source_image) + + if ((foo%i /= 2) .or. (foo%j /= 3)) error stop 1 + sync all + +end program + +! Wrong code generation produced too many temp descriptors +! leading to stacked descriptors handed to the co_broadcast. +! This lead to access to non exsitant memory in opencoarrays. +! In single image mode just checking for reduced number of +! descriptors is possible, i.e., execute always works. +! { dg-final { scan-tree-dump-times "desc\\.\[0-9\]+" 8 "original" } } +