OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Revert "Prevent malicious descriptor stacking for scalar components."

Browse Source 
Breaks bootstrap.

This reverts commit c9c48ab7ba.
This commit is contained in:
Andre Vehreschild 2022-01-28 10:35:07 +01:00
parent c9c48ab7ba
commit 6da86c254a
3 changed files with 43 additions and 105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
gcc/fortran/trans-array.cc
View File

@ -9102,10 +9102,6 @@ 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)
@ -9138,13 +9134,10 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
if (attr->dimension)
{
tmp = gfc_get_element_type (TREE_TYPE (comp));
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);
ubound = gfc_full_array_size (&tmpblock, comp,
c->ts.type == BT_CLASS
? CLASS_DATA (c)->as->rank
: c->as->rank);
}
else
{
@ -9152,36 +9145,26 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
ubound = build_int_cst (gfc_array_index_type, 1);
}
/* 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_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);
if (attr->dimension)
{
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)))
comp = gfc_conv_descriptor_data_get (comp);
else
comp = gfc_build_addr_expr (NULL_TREE, comp);
}
comp = gfc_conv_descriptor_data_get (comp);
else
{
gfc_se se;
@ -9189,18 +9172,14 @@ 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);
if (c->ts.type == BT_CHARACTER)
comp = gfc_build_addr_expr (NULL_TREE, comp);
c->ts.type == BT_CLASS
? CLASS_DATA (c)->attr
: c->attr);
comp = gfc_build_addr_expr (NULL_TREE, comp);
gfc_add_block_to_block (&tmpblock, &se.pre);
}
if (attr->dimension || c->ts.type == BT_CHARACTER)
gfc_conv_descriptor_data_set (&tmpblock, cdesc, comp);
else
cdesc = comp;
gfc_conv_descriptor_data_set (&tmpblock, cdesc, comp);
tree fndecl;

40
gcc/fortran/trans-intrinsic.cc
View File

@ -11212,31 +11212,24 @@ 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 (!derived || !derived->attr.alloc_comp
|| code->resolved_isym->id != GFC_ISYM_CO_BROADCAST)
if (code->ext.actual->expr->rank == 0)
{
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;
}
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);
@ -11297,6 +11290,9 @@ 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'. */

37
gcc/testsuite/gfortran.dg/coarray_collectives_18.f90
View File

@ -1,37 +0,0 @@
! { 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\]+" 12 "original" } }